From 0f6c7e7e2c083ff2e4e95ae6574d0624c6af7f8f Mon Sep 17 00:00:00 2001 From: David Souther Date: Tue, 23 Jul 2013 23:01:20 -0400 Subject: [PATCH 001/133] Added Meditate helper script. Because God designed the universe in Lisp, and built it in Perl. --- Meditate | 15 +++++++++++++++ 1 file changed, 15 insertions(+) create mode 100755 Meditate diff --git a/Meditate b/Meditate new file mode 100755 index 00000000..ddb83d95 --- /dev/null +++ b/Meditate @@ -0,0 +1,15 @@ +#!/bin/sh + +escape=$(echo | tr '\n' '\033') +green="${escape}[32m" +red="${escape}[31m" +reset="${escape}[0m" + +cd ${KOAN_DIR:-~/lisp-koans} +sbcl --script contemplate.lsp | sed \ + -e "s/\(.*awareness\.\)/$green\1$reset/g" \ + -e "s/\(.*meditation\.\)/$red\1$reset/g" \ + -e "s/\(.*incorrect.\)/$red\1$reset/g" \ + -e "/Current koan/N" \ + -e "s/\(\"[^\"]*\"\)/$red\1$reset/g" + From f97844b1903e47028257755bcce87e8eb59ff618 Mon Sep 17 00:00:00 2001 From: Break Yang Date: Mon, 23 Sep 2013 14:32:31 -0400 Subject: [PATCH 002/133] create format.lsp --- koans/format.lsp | 83 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 83 insertions(+) create mode 100644 koans/format.lsp diff --git a/koans/format.lsp b/koans/format.lsp new file mode 100644 index 00000000..56c6c269 --- /dev/null +++ b/koans/format.lsp @@ -0,0 +1,83 @@ +;; 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. + + +;; format is lisp's counterpart to the c function printf. Refer to +;; http://www.gigamonkeys.com/book/a-few-format-recipes.html for more +;; on this topic. + +(define-test test-double-quoted-strings-are-strings + (let ((my-string "do or do not")) + (true-or-false? ___ (typep my-string 'string)) + "strings are the same thing as vectors of characters" + (true-or-false? ___ (typep my-string 'array)) + (assert-equal (aref "meat" 2) (aref "fiesta" 5)) + "strings are not integers :p" + (true-or-false? ___ (typep my-string 'integer)))) + + +(define-test test-multi-line-strings-are-strings + (let ((my-string "this is + a multi + line string")) + (true-or-false? ___ (typep my-string 'string)))) + + +(define-test test-escape-quotes + (let ((my-string "this string has one of these \" in it")) + (true-or-false? ___ (typep my-string 'string)))) + + +; This test from common lisp cookbook +(define-test test-substrings + "since strings are sequences, you may use subseq" + (let ((my-string "Groucho Marx")) + (assert-equal "Marx" (subseq my-string 8)) + (assert-equal (subseq my-string 0 7) ____) + (assert-equal (subseq my-string 1 5) ____))) + +(define-test test-accessing-individual-characters + "char literals look like this" + (true-or-false? ___ (typep #\a 'character)) + (true-or-false? ___ (typep "A" 'character)) + (true-or-false? ___ (typep #\a 'string)) + "char is used to access individual characters" + (let ((my-string "Cookie Monster")) + (assert-equal (char my-string 0) #\C) + (assert-equal (char my-string 3) #\k) + (assert-equal (char my-string 7) ___))) + + +(define-test test-concatenating-strings + "concatenating strings in lisp is a little cumbersome" + (let ((a "this") + (b "is") + (c "unwieldy")) + (assert-equal ___ (concatenate 'string a " " b " " c)))) + + +(define-test test-searching-for-characters + "you can use position to detect characters in strings + (or elements of sequences)" + (assert-equal ___ (position #\b "abc")) + (assert-equal ___ (position #\c "abc")) + (assert-equal ___ (find #\d "abc"))) + + +(define-test test-finding-substrings + "search finds subsequences" + (let ((title "A supposedly fun thing I'll never do again")) + (assert-equal 2 (search "supposedly" title)) + (assert-equal 12 (search "CHANGETHISWORD" title)))) + From 46cb72b4b2227ea4a98dff2894bb99316966dba5 Mon Sep 17 00:00:00 2001 From: Break Yang Date: Mon, 23 Sep 2013 16:32:56 -0400 Subject: [PATCH 003/133] format finished --- .koans | 1 + koans/format.lsp | 136 +++++++++++++++++++++++++---------------------- 2 files changed, 73 insertions(+), 64 deletions(-) diff --git a/.koans b/.koans index 3d09049b..a6108fb7 100644 --- a/.koans +++ b/.koans @@ -1,4 +1,5 @@ ( + :format :asserts :nil-false-empty :evaluation diff --git a/koans/format.lsp b/koans/format.lsp index 56c6c269..b473b8fd 100644 --- a/koans/format.lsp +++ b/koans/format.lsp @@ -13,71 +13,79 @@ ;; limitations under the License. -;; format is lisp's counterpart to the c function printf. Refer to +;; FORMAT is lisp's counterpart to the c function printf. Refer to ;; http://www.gigamonkeys.com/book/a-few-format-recipes.html for more ;; on this topic. -(define-test test-double-quoted-strings-are-strings - (let ((my-string "do or do not")) - (true-or-false? ___ (typep my-string 'string)) - "strings are the same thing as vectors of characters" - (true-or-false? ___ (typep my-string 'array)) - (assert-equal (aref "meat" 2) (aref "fiesta" 5)) - "strings are not integers :p" - (true-or-false? ___ (typep my-string 'integer)))) - - -(define-test test-multi-line-strings-are-strings - (let ((my-string "this is - a multi - line string")) - (true-or-false? ___ (typep my-string 'string)))) - - -(define-test test-escape-quotes - (let ((my-string "this string has one of these \" in it")) - (true-or-false? ___ (typep my-string 'string)))) - - -; This test from common lisp cookbook -(define-test test-substrings - "since strings are sequences, you may use subseq" - (let ((my-string "Groucho Marx")) - (assert-equal "Marx" (subseq my-string 8)) - (assert-equal (subseq my-string 0 7) ____) - (assert-equal (subseq my-string 1 5) ____))) - -(define-test test-accessing-individual-characters - "char literals look like this" - (true-or-false? ___ (typep #\a 'character)) - (true-or-false? ___ (typep "A" 'character)) - (true-or-false? ___ (typep #\a 'string)) - "char is used to access individual characters" - (let ((my-string "Cookie Monster")) - (assert-equal (char my-string 0) #\C) - (assert-equal (char my-string 3) #\k) - (assert-equal (char my-string 7) ___))) - - -(define-test test-concatenating-strings - "concatenating strings in lisp is a little cumbersome" - (let ((a "this") - (b "is") - (c "unwieldy")) - (assert-equal ___ (concatenate 'string a " " b " " c)))) - - -(define-test test-searching-for-characters - "you can use position to detect characters in strings - (or elements of sequences)" - (assert-equal ___ (position #\b "abc")) - (assert-equal ___ (position #\c "abc")) - (assert-equal ___ (find #\d "abc"))) - - -(define-test test-finding-substrings - "search finds subsequences" - (let ((title "A supposedly fun thing I'll never do again")) - (assert-equal 2 (search "supposedly" title)) - (assert-equal 12 (search "CHANGETHISWORD" title)))) + +;; FORMAT takes two fixed parameters. The first one specifies an +;; output stream that the result goes to, and if left as nil, FORMAT +;; will return the output as a string instead. The second parameter +;; specifies the format, where format specifier will be replaced by +;; formatting the rest of the parameters. + + +(define-test test-format-with-plain-text + "If there is no format sepcifier, FORMAT just return the string +itself." + (assert-equal "this is plain text." (format nil "this is plain text."))) + +(define-test test-format-with-general-specifier + "~a is a general specifier that translate to the print form of a + parameter." + (assert-equal "42" (format nil "~a" 42)) + (assert-equal "C" (format nil "~a" #\C)) + (assert-equal "galaxy far far away" (format nil "~a" "galaxy far far away")) + ;; ~a can also translate to list + ;; and parameters to FORMAT are passed by value + (assert-equal "(/ 8 (- 3 (/ 8 3))) evaluates to 24" + (format nil "~a evaluates to ~a" + '(/ 8 (- 3 (/ 8 3))) + (/ 8 (- 3 (/ 8 3)))))) + +(define-test some-fancy-specifiers + "format enclosed by ~{ and ~} applies to every element in a list." + (assert-equal "[1][2][3][4]" + (format nil "~{[~a]~}" '(1 2 3 4))) + ;; ~^ within the ~{ ~} stops processing the last element in the list. + (assert-equal "1|2|3|4|" (format nil "~{~a|~}" '(1 2 3 4))) + (assert-equal "1|2|3|4" (format nil "~{~a~^|~}" '(1 2 3 4))) + ;; ~r reads the interger + (assert-equal "forty-two" (format nil "~r" 42)) + ;; put them all together + (assert-equal "one,two,three,four" + (format nil "~{~r~^,~}" '(1 2 3 4)))) + +;; ---- + +(defun make-matrix (n) + (format nil "write your format here" + (loop for i below n + collect (loop for j below n + collect #\*)))) + +(define-test format-a-matrix + (assert-equal (make-matrix 1) + "*") + (assert-equal (make-matrix 2) +"* * +* *") + (assert-equal (make-matrix 4) +"* * * * +* * * * +* * * * +* * * *")) + + + + + + + + + + + + + From 1ff5900ba2e7ab9bcb34e57a7a8375b39d744b25 Mon Sep 17 00:00:00 2001 From: Break Yang Date: Mon, 23 Sep 2013 16:41:20 -0400 Subject: [PATCH 004/133] convert example to exercises --- koans/format.lsp | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/koans/format.lsp b/koans/format.lsp index b473b8fd..f9a44ba6 100644 --- a/koans/format.lsp +++ b/koans/format.lsp @@ -28,32 +28,32 @@ (define-test test-format-with-plain-text "If there is no format sepcifier, FORMAT just return the string itself." - (assert-equal "this is plain text." (format nil "this is plain text."))) + (assert-equal ___ (format nil "this is plain text."))) (define-test test-format-with-general-specifier "~a is a general specifier that translate to the print form of a parameter." - (assert-equal "42" (format nil "~a" 42)) - (assert-equal "C" (format nil "~a" #\C)) - (assert-equal "galaxy far far away" (format nil "~a" "galaxy far far away")) + (assert-equal ___ (format nil "~a" 42)) + (assert-equal ___ (format nil "~a" #\C)) + (assert-equal ___ (format nil "~a" "galaxy far far away")) ;; ~a can also translate to list ;; and parameters to FORMAT are passed by value - (assert-equal "(/ 8 (- 3 (/ 8 3))) evaluates to 24" + (assert-equal ___ (format nil "~a evaluates to ~a" '(/ 8 (- 3 (/ 8 3))) (/ 8 (- 3 (/ 8 3)))))) (define-test some-fancy-specifiers "format enclosed by ~{ and ~} applies to every element in a list." - (assert-equal "[1][2][3][4]" + (assert-equal ___ (format nil "~{[~a]~}" '(1 2 3 4))) ;; ~^ within the ~{ ~} stops processing the last element in the list. - (assert-equal "1|2|3|4|" (format nil "~{~a|~}" '(1 2 3 4))) - (assert-equal "1|2|3|4" (format nil "~{~a~^|~}" '(1 2 3 4))) + (assert-equal "1|2|3|4|" (format nil ___ '(1 2 3 4))) + (assert-equal ___ (format nil "~{~a~^|~}" '(1 2 3 4))) ;; ~r reads the interger - (assert-equal "forty-two" (format nil "~r" 42)) + (assert-equal ___ (format nil "~r" 42)) ;; put them all together - (assert-equal "one,two,three,four" + (assert-equal ___ (format nil "~{~r~^,~}" '(1 2 3 4)))) ;; ---- From ece631384658c8ed86449a1ba511502fd66568aa Mon Sep 17 00:00:00 2001 From: Break Yang Date: Tue, 24 Sep 2013 11:41:20 -0400 Subject: [PATCH 005/133] add solutions. --- solutions/format.lsp | 78 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 78 insertions(+) create mode 100644 solutions/format.lsp diff --git a/solutions/format.lsp b/solutions/format.lsp new file mode 100644 index 00000000..374fd08c --- /dev/null +++ b/solutions/format.lsp @@ -0,0 +1,78 @@ +;; 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. + + +;; FORMAT is lisp's counterpart to the c function printf. Refer to +;; http://www.gigamonkeys.com/book/a-few-format-recipes.html for more +;; on this topic. + + +;; FORMAT takes two fixed parameters. The first one specifies an +;; output stream that the result goes to, and if left as nil, FORMAT +;; will return the output as a string instead. The second parameter +;; specifies the format, where format specifier will be replaced by +;; formatting the rest of the parameters. + + +(define-test test-format-with-plain-text + "If there is no format sepcifier, FORMAT just return the string +itself." + (assert-equal "this is plain text." (format nil "this is plain text."))) + +(define-test test-format-with-general-specifier + "~a is a general specifier that translate to the print form of a + parameter." + (assert-equal "42" (format nil "~a" 42)) + (assert-equal "C" (format nil "~a" #\C)) + (assert-equal "galaxy far far away" (format nil "~a" "galaxy far far away")) + ;; ~a can also translate to list + ;; and parameters to FORMAT are passed by value + (assert-equal "(/ 8 (- 3 (/ 8 3))) evaluates to 24" + (format nil "~a evaluates to ~a" + '(/ 8 (- 3 (/ 8 3))) + (/ 8 (- 3 (/ 8 3)))))) + +(define-test some-fancy-specifiers + "format enclosed by ~{ and ~} applies to every element in a list." + (assert-equal "[1][2][3][4]" + (format nil "~{[~a]~}" '(1 2 3 4))) + ;; ~^ within the ~{ ~} stops processing the last element in the list. + (assert-equal "1|2|3|4|" (format nil "~{~a|~}" '(1 2 3 4))) + (assert-equal "1|2|3|4" (format nil "~{~a~^|~}" '(1 2 3 4))) + ;; ~r reads the interger + (assert-equal "forty-two" (format nil "~r" 42)) + ;; put them all together + (assert-equal "one,two,three,four" + (format nil "~{~r~^,~}" '(1 2 3 4)))) + +;; ---- + +(defun make-matrix (n) + (format nil "write your format here" + (loop for i below n + collect (loop for j below n + collect #\*)))) + +(define-test format-a-matrix + (assert-equal (make-matrix 1) + "*") + (assert-equal (make-matrix 2) +"* * +* *") + (assert-equal (make-matrix 4) +"* * * * +* * * * +* * * * +* * * *")) + From e4f1813d216a8d4cd62a34cd3fab9e2fc88903ba Mon Sep 17 00:00:00 2001 From: Michael Wolber Date: Mon, 30 Sep 2013 01:00:27 +0200 Subject: [PATCH 006/133] Added eval/load support within the Clozure/CCL IDE on OSX. --- contemplate.lsp | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/contemplate.lsp b/contemplate.lsp index a6cf0e7a..999b62c9 100644 --- a/contemplate.lsp +++ b/contemplate.lsp @@ -15,6 +15,14 @@ (in-package :cl-user) +;; Though Clozure / CCL runs lisp-koans on the command line using +;; "ccl -l contemplate.lsp", the following lines are needed to +;; meditate on the koans within the CCL IDE. +;; (The :hemlock is used to distiguish between ccl commandline and the IDE) +#+(and :ccl :hemlock) +(setf *default-pathname-defaults* (directory-namestring *load-pathname*)) + + ;; lisp-unit defines the modules for loading / executing koans (load "lisp-unit.lsp") From 1e480396b29ecee16f31a5a74c9f8b1fce1ed468 Mon Sep 17 00:00:00 2001 From: Stanley Bileschi Date: Wed, 5 Mar 2014 03:29:37 -0500 Subject: [PATCH 007/133] Update arrays.lsp --- koans/arrays.lsp | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/koans/arrays.lsp b/koans/arrays.lsp index 137049db..27535070 100644 --- a/koans/arrays.lsp +++ b/koans/arrays.lsp @@ -57,8 +57,7 @@ (assert-equal (aref x 1 0) 5) (assert-equal (array-dimensions x) '(2 2)) (adjust-array x '(3 4)) - (assert-equal (array-dimensions x) '(3 4)) - (assert-equal (aref x 2 3) ____))) + (assert-equal (array-dimensions x) '(3 4)))) (define-test test-make-array-from-list @@ -76,4 +75,4 @@ (dotimes (i (* 2 2 2 2)) (setf (row-major-aref my-array i) i)) (assert-equal (aref my-array 0 0 0 0) ____) - (assert-equal (aref my-array 1 1 1 1) ____))) \ No newline at end of file + (assert-equal (aref my-array 1 1 1 1) ____))) From 6b4755ffd2b88e99054a75c83db26d05ffa5de61 Mon Sep 17 00:00:00 2001 From: Stanley Bileschi Date: Wed, 5 Mar 2014 03:31:20 -0500 Subject: [PATCH 008/133] Update hash-tables.lsp eins zwei ... --- koans/hash-tables.lsp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/koans/hash-tables.lsp b/koans/hash-tables.lsp index 7afbb591..23b16eee 100644 --- a/koans/hash-tables.lsp +++ b/koans/hash-tables.lsp @@ -89,10 +89,10 @@ (expected (make-hash-table :test #'equal))) (setf (gethash "one" babel-fish) "uno") (setf (gethash "two" babel-fish) "dos") - (setf (gethash "one" expected) "ein") + (setf (gethash "one" expected) "eins") (setf (gethash "two" expected) "zwei") - (setf (gethash "one" babel-fish) "ein") + (setf (gethash "one" babel-fish) "eins") (setf (gethash "two" babel-fish) ____) (assert-true (equalp babel-fish expected)))) From 18800309fb3936723e4cf5b63222f556ecea5d86 Mon Sep 17 00:00:00 2001 From: Dan Kee Date: Thu, 26 Jun 2014 22:32:08 -0500 Subject: [PATCH 009/133] Fix log-form and log-form-with-value macros. --- koans/macros.lsp | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/koans/macros.lsp b/koans/macros.lsp index 769eb887..3156d8c0 100644 --- a/koans/macros.lsp +++ b/koans/macros.lsp @@ -108,10 +108,10 @@ (defvar *log* nil) -(defmacro log-form (&body body) +(defmacro log-form (form) "records the body form to the list *log* and then evalues the body normally" - `(let ((retval ,@body)) - (push ',@body *log*) + `(let ((retval ,form)) + (push ',form *log*) retval)) (define-test test-basic-log-form @@ -135,11 +135,11 @@ (defvar *log-with-value* nil) ;; you must write this macro -(defmacro log-form-with-value (&body body) +(defmacro log-form-with-value (form) "records the body form, and the form's return value to the list *log-with-value* and then evalues the body normally" `(let ((logform nil) - (retval ,@body)) + (retval ,form)) ;; YOUR MACRO COMPLETION CODE GOES HERE. From 956ba3f75cb428f49cbbbcfffbbf18aae743b915 Mon Sep 17 00:00:00 2001 From: "Christopher L. Simons" Date: Wed, 25 Mar 2015 14:32:07 -0400 Subject: [PATCH 010/133] koans/macros.lsp: Fixed typographical error ('rather then' -> 'rather than'). --- koans/macros.lsp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/koans/macros.lsp b/koans/macros.lsp index 769eb887..b3b1a43c 100644 --- a/koans/macros.lsp +++ b/koans/macros.lsp @@ -39,7 +39,7 @@ (define-test test-backtick-form "backtick (`) form is much like single-quote (') form, except that subforms - preceded by a comma (,) are evaluated, rather then left as literals" + preceded by a comma (,) are evaluated, rather than left as literals" (let ((num 5) (word 'dolphin)) (true-or-false? ___ (equal '(1 3 5) `(1 3 5))) From 2229c58f3bc3f4228b49855c7a4bc64fbe154b1d Mon Sep 17 00:00:00 2001 From: flpa Date: Wed, 15 Jul 2015 19:09:43 +0200 Subject: [PATCH 011/133] Minor fix in inline instructions Instructions in the very first koan mentioned 'define-koan' blocks, but there are only 'define-test' blocks --- koans/asserts.lsp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/koans/asserts.lsp b/koans/asserts.lsp index 476b196f..ffcd9763 100644 --- a/koans/asserts.lsp +++ b/koans/asserts.lsp @@ -15,7 +15,7 @@ ; Concept: What do you do to go through the lisp koans? You fill in ; the blanks, or otherwise fix the lisp code so that the -; code within the 'define-koan' blocks passes. +; code within the 'define-test' blocks passes. ; In common lisp, "True" and "False" are represented by "t" and "nil". From 093459694fdb7a41dc9097fa980232d1bcccc405 Mon Sep 17 00:00:00 2001 From: flpa Date: Thu, 6 Aug 2015 14:18:05 +0200 Subject: [PATCH 012/133] special-forms.lsp: Addcase koans, modify cond koans --- koans/special-forms.lsp | 49 ++++++++++++++++++++++++++++++++--------- 1 file changed, 38 insertions(+), 11 deletions(-) diff --git a/koans/special-forms.lsp b/koans/special-forms.lsp index d4e7fb04..225ea3a6 100644 --- a/koans/special-forms.lsp +++ b/koans/special-forms.lsp @@ -94,25 +94,52 @@ (assert-equal b 200) (assert-equal c (+ a (/ b a))))) - -(define-test test-cond - "the cond form is like the c switch statement" +(define-test test-case + "the case form is like the C switch statement: it + compares an input with a set of values and evaluates an + expression once a match is found" (setf a 4) + (setf b + (case a (4 :four) + (5 :five) + ;; t specifies default behavior + (t :unknown))) + (assert-equal ____ b) + "case can also check if a list of values contains + the input" (setf c - (cond ((> a 0) :positive) - ((< a 0) :negative) - (t :zero))) + (case a (5 :five) + ((3 4) :three-or-four))) (assert-equal ____ c)) - (defun cartoon-dads (input) - " you should be able to complete this cond statement" - (cond ((equal input :this-one-doesnt-happen) :fancy-cat) - (t :unknown))) + "you should be able to complete this case statement" + (case input (:this-one-doesnt-happen :fancy-cat) + (t :unknown))) -(define-test test-your-own-cond-statement +(define-test test-your-own-case-statement "fix this by completing the 'cartoon-dads' function above" (assert-equal (cartoon-dads :bart) :homer) (assert-equal (cartoon-dads :stewie) :peter) (assert-equal (cartoon-dads :stan) :randy) (assert-equal (cartoon-dads :space-ghost) :unknown)) + +(define-test test-limits-of-case + "case is not suitable for all kinds of values, because + it uses the function eql for comparisons. We will explore + the implications of this in the equality-distinctions lesson" + (let* ((name "John") + (lastname (case name ("John" "Doe") + ("Max" "Mustermann") + (t "Anonymous")))) + (assert-equal ____ lastname))) + +(define-test test-cond + "cond is the general purpose form for checking multiple + conditions, until a condition is met" + (setf a 4) + (setf c + (cond ((> a 0) :positive) + ((< a 0) :negative) + (t :zero))) + (assert-equal ____ c)) From 3aa56668897c233a60b19d8e37fc81a8980d3e17 Mon Sep 17 00:00:00 2001 From: flpa Date: Fri, 7 Aug 2015 00:35:20 +0200 Subject: [PATCH 013/133] iterations.lsp: Fix typos and grammar --- koans/iteration.lsp | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/koans/iteration.lsp b/koans/iteration.lsp index b846cc48..b9cdbf83 100644 --- a/koans/iteration.lsp +++ b/koans/iteration.lsp @@ -17,7 +17,7 @@ ;; This set of koans will introduce a few of the most common ones -;; Dolist evaluates a form for every element om a list. +;; Dolist evaluates a form for every element of a list. (defvar some-primes '(10301 11311 19991 999565999)) @@ -26,7 +26,7 @@ variable in turn" (let ((how-many-in-list 0) (biggest-in-list (first some-primes))) - "this dolist loops over the some-primes, defined above" + "this dolist loops over some-primes, defined above" (dolist (one-prime some-primes) (if (> one-prime biggest-in-list) (setf biggest-in-list one-prime)) @@ -34,7 +34,7 @@ (assert-equal ___ how-many-in-list) (assert-equal ___ biggest-in-list)) (let ((sum 0)) - "write your own do-list here to calculate the sum of some-primes" + "write your own dolist here to calculate the sum of some-primes" "you may be interested in investigating the 'incf' function" ;(dolist ... ) (assert-equal 999607602 sum))) @@ -79,7 +79,7 @@ (define-test test-mapcar - "mapcar takes a list an a function. It returns a new list + "mapcar takes a list and a function. It returns a new list with the function applied to each element of the input" (let ((mc-result (mapcar #'evenp '(1 2 3 4 5)))) (assert-equal mc-result ____))) @@ -89,7 +89,7 @@ (defun vowelp (c) - "returns true iff c is a vowel" + "returns true if c is a vowel" (find c "AEIOUaeiou")) (defun vowels-to-xs (my-string) From 3740b2ca6e5bede3b6bdfe451a7d7761d8f1bae8 Mon Sep 17 00:00:00 2001 From: Hettomei Date: Sun, 18 Oct 2015 14:29:31 +0200 Subject: [PATCH 014/133] multiple-values.lsp: Fix typo --- koans/multiple-values.lsp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/koans/multiple-values.lsp b/koans/multiple-values.lsp index d3d42c3f..fafbfbff 100644 --- a/koans/multiple-values.lsp +++ b/koans/multiple-values.lsp @@ -36,7 +36,7 @@ This is distinct from returning a list or structure of values." (assert-equal x ___) (setf x (multiple-value-list (next-fib 2 3))) (assert-equal x ___) - "multiple value bind binds the variables in the first form + "multiple-value-bind binds the variables in the first form to the outputs of the second form. And then returns the output of the third form using those bindings" (setf y (multiple-value-bind (b c) (next-fib 3 5) (* b c))) From 88576f90297c6f19d63262c6d4f028538a94d4a7 Mon Sep 17 00:00:00 2001 From: chuchana Date: Sat, 14 Nov 2015 16:12:48 +0100 Subject: [PATCH 015/133] Update iteration.lsp fixed typo --- koans/iteration.lsp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/koans/iteration.lsp b/koans/iteration.lsp index b846cc48..c7e7da70 100644 --- a/koans/iteration.lsp +++ b/koans/iteration.lsp @@ -89,7 +89,7 @@ (defun vowelp (c) - "returns true iff c is a vowel" + "returns true if c is a vowel" (find c "AEIOUaeiou")) (defun vowels-to-xs (my-string) From 072cbe4f4a1686538dbd4f825ba41233ace2c1a6 Mon Sep 17 00:00:00 2001 From: Michael Becker Date: Mon, 21 Dec 2015 18:03:25 -0800 Subject: [PATCH 016/133] Add Ansi terminal colors to output I thought it would be nice to add some red/green to the terminal output. I did this by wrapping some of the output strings with terminal codes ([reference][0]. If there is a more portable, lispy way to do this, feel free to close the PR. [0]:http://wiki.bash-hackers.org/scripting/terminalcodes --- contemplate.lsp | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/contemplate.lsp b/contemplate.lsp index a6cf0e7a..01f8aea1 100644 --- a/contemplate.lsp +++ b/contemplate.lsp @@ -84,8 +84,8 @@ #'(lambda (x) (equalp :pass x)) (second k-result)))) (if all-pass-p - (format t "~A has expanded your awareness.~%" koan-name) - (format t "~A requires more meditation.~%" koan-name)))) + (format t "~A has expanded your awareness.~%" koan-name) + (format t "~A requires more meditation.~%" koan-name)))) (defun print-koan-group-progress (kg-name kg-results) (format t "~%Thinking about ~A~%" kg-name) @@ -118,10 +118,10 @@ (defun koan-status-message (koan-status) (if (find :incomplete koan-status) (return-from koan-status-message - " A koan is incomplete.~%")) + " A koan is incomplete.~%")) (if (find :fail koan-status) (return-from koan-status-message - " A koan is incorrect.~%")) + " A koan is incorrect.~%")) (if (find :error koan-status) (return-from koan-status-message " A koan threw an error.~%")) @@ -135,7 +135,7 @@ (format t "You have not yet reached enlightenment ...~%") (format t (koan-status-message koan-status)) (format t "~%") - (format t "Please meditate on the following code:~%") + (format t "Please meditate on the following code:~%") (format t " File \"~A/~A.lsp\"~%" *koan-dir-name* (string-downcase filename)) (format t " Koan \"~A\"~%" koan-name) (format t " Current koan assert status is \"~A\"~%" (reverse koan-status)))) From 98de6ebc670537cea901476f059ef3bedb4f645e Mon Sep 17 00:00:00 2001 From: Jamil Dhanani Date: Tue, 22 Dec 2015 14:27:30 -0500 Subject: [PATCH 017/133] Remove assignment of hash table to 'values' variable --- koans/hash-tables.lsp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/koans/hash-tables.lsp b/koans/hash-tables.lsp index 23b16eee..17ed0b90 100644 --- a/koans/hash-tables.lsp +++ b/koans/hash-tables.lsp @@ -119,7 +119,7 @@ (define-test test-make-your-own-hash-table "make a hash table that meets the following conditions" (let ((colors (make-hash-table)) - (values (make-hash-table))) + values) (assert-equal (hash-table-count colors) 4) (setf values (list (gethash "blue" colors) From c45d7adeef691ae00b7e280886d770c220a628d8 Mon Sep 17 00:00:00 2001 From: Darrin Chandler Date: Sun, 24 Jan 2016 14:27:19 -0700 Subject: [PATCH 018/133] Fix indent in test-transpose-using-mapcar --- koans/mapcar-and-reduce.lsp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/koans/mapcar-and-reduce.lsp b/koans/mapcar-and-reduce.lsp index 571f4aa5..d3bc4735 100644 --- a/koans/mapcar-and-reduce.lsp +++ b/koans/mapcar-and-reduce.lsp @@ -35,7 +35,7 @@ the #') to take the 'transpose'." (defun WRONG-FUNCTION-1 (&rest rest) '()) (defun transpose (L) (apply #'mapcar (cons #'WRONG-FUNCTION-1 L))) - (assert-equal '((1 4 7) + (assert-equal '((1 4 7) (2 5 8) (3 6 9)) (transpose '((1 2 3) @@ -45,7 +45,7 @@ ("making" "me" "thirsty")) (transpose '(("these" "making") ("pretzels" "me") - ("are" "thirsty"))))) + ("are" "thirsty"))))) (define-test test-reduce-basics From 18ec2b2b8dee483ef1c50f80ee7ff955dec7aba1 Mon Sep 17 00:00:00 2001 From: "Mingyoo, Jung" Date: Sat, 13 Feb 2016 00:31:49 +0900 Subject: [PATCH 019/133] Fix comment --- koans/threads.lsp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/koans/threads.lsp b/koans/threads.lsp index 2fe6f4d8..4d20a4d4 100644 --- a/koans/threads.lsp +++ b/koans/threads.lsp @@ -74,8 +74,8 @@ (defun double-wrap-list (x y z) (list (list x y z))) -;; Create a thread which will print out "Hello -Name-" using -;; the named write-hello-name function. Arguments are handed +;; Create a thread which will return "Hello -Name-" using +;; the named returns-hello-name function. Arguments are handed ;; to threads as a list, unless there is just a single argument ;; then it does not need to be wrapped in a list. From 41582eda998605de0f646fbc7670673430441bc3 Mon Sep 17 00:00:00 2001 From: Stanley Bileschi Date: Sun, 28 Feb 2016 17:32:24 +0800 Subject: [PATCH 020/133] Adds a comment to Meditate to indicate that the user should update the working directory. --- Meditate | 1 + 1 file changed, 1 insertion(+) diff --git a/Meditate b/Meditate index ddb83d95..a4c21740 100755 --- a/Meditate +++ b/Meditate @@ -5,6 +5,7 @@ green="${escape}[32m" red="${escape}[31m" reset="${escape}[0m" +# Update ~/lisp-koans to your working directory. cd ${KOAN_DIR:-~/lisp-koans} sbcl --script contemplate.lsp | sed \ -e "s/\(.*awareness\.\)/$green\1$reset/g" \ From 42b478fcb50d9d4d02b2cb62004545d1a8cfdfd0 Mon Sep 17 00:00:00 2001 From: Stanley Bileschi Date: Sun, 28 Feb 2016 17:40:01 +0800 Subject: [PATCH 021/133] Moves :format lesson later in the curriculum. Removes matrix test for lack of a provided solution. Fixes some formatting. --- .koans | 2 +- koans/format.lsp | 47 ++++++++++++-------------------------------- solutions/format.lsp | 19 ------------------ 3 files changed, 14 insertions(+), 54 deletions(-) diff --git a/.koans b/.koans index a6108fb7..7e599d00 100644 --- a/.koans +++ b/.koans @@ -1,5 +1,4 @@ ( - :format :asserts :nil-false-empty :evaluation @@ -21,6 +20,7 @@ :loops :triangle-project :scoring-project + :format :type-checking :clos :dice-project diff --git a/koans/format.lsp b/koans/format.lsp index f9a44ba6..af2aef4e 100644 --- a/koans/format.lsp +++ b/koans/format.lsp @@ -24,14 +24,13 @@ ;; specifies the format, where format specifier will be replaced by ;; formatting the rest of the parameters. - (define-test test-format-with-plain-text - "If there is no format sepcifier, FORMAT just return the string + "If there is no format sepcifier, FORMAT just return the string itself." (assert-equal ___ (format nil "this is plain text."))) (define-test test-format-with-general-specifier - "~a is a general specifier that translate to the print form of a + "~a is a general specifier that translate to the print form of a parameter." (assert-equal ___ (format nil "~a" 42)) (assert-equal ___ (format nil "~a" #\C)) @@ -44,37 +43,17 @@ itself." (/ 8 (- 3 (/ 8 3)))))) (define-test some-fancy-specifiers - "format enclosed by ~{ and ~} applies to every element in a list." - (assert-equal ___ - (format nil "~{[~a]~}" '(1 2 3 4))) - ;; ~^ within the ~{ ~} stops processing the last element in the list. - (assert-equal "1|2|3|4|" (format nil ___ '(1 2 3 4))) - (assert-equal ___ (format nil "~{~a~^|~}" '(1 2 3 4))) - ;; ~r reads the interger - (assert-equal ___ (format nil "~r" 42)) - ;; put them all together - (assert-equal ___ - (format nil "~{~r~^,~}" '(1 2 3 4)))) - -;; ---- - -(defun make-matrix (n) - (format nil "write your format here" - (loop for i below n - collect (loop for j below n - collect #\*)))) - -(define-test format-a-matrix - (assert-equal (make-matrix 1) - "*") - (assert-equal (make-matrix 2) -"* * -* *") - (assert-equal (make-matrix 4) -"* * * * -* * * * -* * * * -* * * *")) + "format enclosed by ~{ and ~} applies to every element in a list." + (assert-equal ___ + (format nil "~{[~a]~}" '(1 2 3 4))) + ;; ~^ within the ~{ ~} stops processing the last element in the list. + (assert-equal "1|2|3|4|" (format nil ___ '(1 2 3 4))) + (assert-equal ___ (format nil "~{~a~^|~}" '(1 2 3 4))) + ;; ~r reads the interger + (assert-equal ___ (format nil "~r" 42)) + ;; put them all together + (assert-equal ___ + (format nil "~{~r~^,~}" '(1 2 3 4)))) diff --git a/solutions/format.lsp b/solutions/format.lsp index 374fd08c..9e2ebca0 100644 --- a/solutions/format.lsp +++ b/solutions/format.lsp @@ -56,23 +56,4 @@ itself." (assert-equal "one,two,three,four" (format nil "~{~r~^,~}" '(1 2 3 4)))) -;; ---- - -(defun make-matrix (n) - (format nil "write your format here" - (loop for i below n - collect (loop for j below n - collect #\*)))) - -(define-test format-a-matrix - (assert-equal (make-matrix 1) - "*") - (assert-equal (make-matrix 2) -"* * -* *") - (assert-equal (make-matrix 4) -"* * * * -* * * * -* * * * -* * * *")) From 4689009ccbbdf6b5b03832097758a55a14fb77cb Mon Sep 17 00:00:00 2001 From: Stanley Bileschi Date: Sun, 28 Feb 2016 17:44:03 +0800 Subject: [PATCH 022/133] Removes (partial) solutions directory mistakenly added. --- solutions/format.lsp | 59 -------------------------------------------- 1 file changed, 59 deletions(-) delete mode 100644 solutions/format.lsp diff --git a/solutions/format.lsp b/solutions/format.lsp deleted file mode 100644 index 9e2ebca0..00000000 --- a/solutions/format.lsp +++ /dev/null @@ -1,59 +0,0 @@ -;; 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. - - -;; FORMAT is lisp's counterpart to the c function printf. Refer to -;; http://www.gigamonkeys.com/book/a-few-format-recipes.html for more -;; on this topic. - - -;; FORMAT takes two fixed parameters. The first one specifies an -;; output stream that the result goes to, and if left as nil, FORMAT -;; will return the output as a string instead. The second parameter -;; specifies the format, where format specifier will be replaced by -;; formatting the rest of the parameters. - - -(define-test test-format-with-plain-text - "If there is no format sepcifier, FORMAT just return the string -itself." - (assert-equal "this is plain text." (format nil "this is plain text."))) - -(define-test test-format-with-general-specifier - "~a is a general specifier that translate to the print form of a - parameter." - (assert-equal "42" (format nil "~a" 42)) - (assert-equal "C" (format nil "~a" #\C)) - (assert-equal "galaxy far far away" (format nil "~a" "galaxy far far away")) - ;; ~a can also translate to list - ;; and parameters to FORMAT are passed by value - (assert-equal "(/ 8 (- 3 (/ 8 3))) evaluates to 24" - (format nil "~a evaluates to ~a" - '(/ 8 (- 3 (/ 8 3))) - (/ 8 (- 3 (/ 8 3)))))) - -(define-test some-fancy-specifiers - "format enclosed by ~{ and ~} applies to every element in a list." - (assert-equal "[1][2][3][4]" - (format nil "~{[~a]~}" '(1 2 3 4))) - ;; ~^ within the ~{ ~} stops processing the last element in the list. - (assert-equal "1|2|3|4|" (format nil "~{~a|~}" '(1 2 3 4))) - (assert-equal "1|2|3|4" (format nil "~{~a~^|~}" '(1 2 3 4))) - ;; ~r reads the interger - (assert-equal "forty-two" (format nil "~r" 42)) - ;; put them all together - (assert-equal "one,two,three,four" - (format nil "~{~r~^,~}" '(1 2 3 4)))) - - From 70de66b9270e93b61ba516bfae4c2441d7e890e0 Mon Sep 17 00:00:00 2001 From: Stanley Bileschi Date: Sun, 28 Feb 2016 18:02:11 +0800 Subject: [PATCH 023/133] Removing 'Meditate' now that contemplate.lsp supports ANSI color. --- Meditate | 16 ---------------- 1 file changed, 16 deletions(-) delete mode 100755 Meditate diff --git a/Meditate b/Meditate deleted file mode 100755 index a4c21740..00000000 --- a/Meditate +++ /dev/null @@ -1,16 +0,0 @@ -#!/bin/sh - -escape=$(echo | tr '\n' '\033') -green="${escape}[32m" -red="${escape}[31m" -reset="${escape}[0m" - -# Update ~/lisp-koans to your working directory. -cd ${KOAN_DIR:-~/lisp-koans} -sbcl --script contemplate.lsp | sed \ - -e "s/\(.*awareness\.\)/$green\1$reset/g" \ - -e "s/\(.*meditation\.\)/$red\1$reset/g" \ - -e "s/\(.*incorrect.\)/$red\1$reset/g" \ - -e "/Current koan/N" \ - -e "s/\(\"[^\"]*\"\)/$red\1$reset/g" - From b146521bcf1b842b19b4492073ec6bc88bf58554 Mon Sep 17 00:00:00 2001 From: astronut-wannabe Date: Thu, 10 Mar 2016 14:00:54 -0800 Subject: [PATCH 024/133] reword test-transpose-using-mapcar doc string --- koans/mapcar-and-reduce.lsp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/koans/mapcar-and-reduce.lsp b/koans/mapcar-and-reduce.lsp index d3bc4735..e8793184 100644 --- a/koans/mapcar-and-reduce.lsp +++ b/koans/mapcar-and-reduce.lsp @@ -31,8 +31,8 @@ (define-test test-transpose-using-mapcar - "Replace WRONG-FUNCTION with the correct function (don't forget - the #') to take the 'transpose'." + "Replace the usage of WRONG-FUNCTION in 'transpose' with the + correct lisp function (don't forget the #')." (defun WRONG-FUNCTION-1 (&rest rest) '()) (defun transpose (L) (apply #'mapcar (cons #'WRONG-FUNCTION-1 L))) (assert-equal '((1 4 7) From 0429d8fb1132496782d4ef2ff95b7c8b5b224a28 Mon Sep 17 00:00:00 2001 From: astronut-wannabe Date: Fri, 11 Mar 2016 15:05:02 -0800 Subject: [PATCH 025/133] Rephrase the doc-string for test-reduce-basics --- koans/mapcar-and-reduce.lsp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/koans/mapcar-and-reduce.lsp b/koans/mapcar-and-reduce.lsp index e8793184..31c4e659 100644 --- a/koans/mapcar-and-reduce.lsp +++ b/koans/mapcar-and-reduce.lsp @@ -49,9 +49,9 @@ (define-test test-reduce-basics - "The reduce function applies uses a supplied - binary function to combine the elements of a - list from left to right." + "The reduce function combines the elements + of a list, from left to right, by applying + a binary function to the list elements." (assert-equal ___ (reduce #'+ '(1 2 3 4))) (assert-equal ___ (reduce #'expt '(2 3 2)))) From 7eb25bcdc5a60ba79b36ad29ab43fccdf29eec84 Mon Sep 17 00:00:00 2001 From: astronut-wannabe Date: Sat, 12 Mar 2016 13:31:17 -0800 Subject: [PATCH 026/133] fix some typos in format.lsp --- koans/format.lsp | 32 +++++++++----------------------- 1 file changed, 9 insertions(+), 23 deletions(-) diff --git a/koans/format.lsp b/koans/format.lsp index af2aef4e..804a9611 100644 --- a/koans/format.lsp +++ b/koans/format.lsp @@ -25,12 +25,12 @@ ;; formatting the rest of the parameters. (define-test test-format-with-plain-text - "If there is no format sepcifier, FORMAT just return the string -itself." + "If there is no format specifier, FORMAT just returns the string + itself." (assert-equal ___ (format nil "this is plain text."))) (define-test test-format-with-general-specifier - "~a is a general specifier that translate to the print form of a + "~a is a general specifier that translates to the print form of a parameter." (assert-equal ___ (format nil "~a" 42)) (assert-equal ___ (format nil "~a" #\C)) @@ -38,33 +38,19 @@ itself." ;; ~a can also translate to list ;; and parameters to FORMAT are passed by value (assert-equal ___ - (format nil "~a evaluates to ~a" - '(/ 8 (- 3 (/ 8 3))) - (/ 8 (- 3 (/ 8 3)))))) + (format nil "~a evaluates to ~a" + '(/ 8 (- 3 (/ 8 3))) + (/ 8 (- 3 (/ 8 3)))))) (define-test some-fancy-specifiers "format enclosed by ~{ and ~} applies to every element in a list." (assert-equal ___ - (format nil "~{[~a]~}" '(1 2 3 4))) + (format nil "~{[~a]~}" '(1 2 3 4))) ;; ~^ within the ~{ ~} stops processing the last element in the list. (assert-equal "1|2|3|4|" (format nil ___ '(1 2 3 4))) (assert-equal ___ (format nil "~{~a~^|~}" '(1 2 3 4))) - ;; ~r reads the interger + ;; ~r reads the integer (assert-equal ___ (format nil "~r" 42)) ;; put them all together (assert-equal ___ - (format nil "~{~r~^,~}" '(1 2 3 4)))) - - - - - - - - - - - - - - + (format nil "~{~r~^,~}" '(1 2 3 4)))) From a182788259cabefad924a9b03c325e76ca2de605 Mon Sep 17 00:00:00 2001 From: Matthew Schallenkamp Date: Mon, 16 May 2016 00:40:50 -0500 Subject: [PATCH 027/133] Fix Issue #47 Simple fix, just replaced parts of the assert with the ____ placeholder. --- koans/arrays.lsp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/koans/arrays.lsp b/koans/arrays.lsp index 27535070..873a1579 100644 --- a/koans/arrays.lsp +++ b/koans/arrays.lsp @@ -54,10 +54,10 @@ (define-test test-adjustable-array "one may build arrays that can change size" (let ((x (make-array '(2 2) :initial-element 5 :adjustable t))) - (assert-equal (aref x 1 0) 5) - (assert-equal (array-dimensions x) '(2 2)) + (assert-equal (aref x 1 0) ____) + (assert-equal (array-dimensions x) ____) (adjust-array x '(3 4)) - (assert-equal (array-dimensions x) '(3 4)))) + (assert-equal (array-dimensions x) ____))) (define-test test-make-array-from-list From 7ed0c9b886bd2c2bdf6b1da494f6a85b07ca8afb Mon Sep 17 00:00:00 2001 From: "Pascal J. Bourguignon" Date: Fri, 3 Mar 2017 15:08:49 +0100 Subject: [PATCH 028/133] Deleted trailing whitespaces. --- README.md | 6 +++--- contemplate.lsp | 4 ++-- koans/asserts.lsp | 2 +- koans/mapcar-and-reduce.lsp | 14 +++++++------- koans/scope-and-extent.lsp | 2 +- koans/special-forms.lsp | 2 +- koans/threads.lsp | 6 +++--- lisp-unit.lsp | 26 +++++++++++++------------- 8 files changed, 31 insertions(+), 31 deletions(-) diff --git a/README.md b/README.md index 2ea734dd..2872a34a 100644 --- a/README.md +++ b/README.md @@ -23,14 +23,14 @@ You are now 0/169 koans and 0/25 lessons closer to reaching enlightenment ``` This indicates that the script has completed, and that the learner should look -to asserts.lsp to locate and fix the problem. The problem will be within +to asserts.lsp to locate and fix the problem. The problem will be within a define-test expression such as (define-test assert-true "t is true. Replace the blank with a t" (assert-true ___)) -In this case, the test is incomplete, and the student should fill +In this case, the test is incomplete, and the student should fill in the blank (____) with appropriate lisp code to make the assert pass. @@ -40,7 +40,7 @@ and paste code into the lisp command line REPL. Quoting the Ruby Koans instructions:: ------------------------------------- - "In test-driven development the mantra has always been, red, green, + "In test-driven development the mantra has always been, red, green, refactor. Write a failing test and run it (red), make the test pass (green), then refactor it (that is look at the code and see if you can make it any better). In this case you will need to run the koan and see it fail (red), make diff --git a/contemplate.lsp b/contemplate.lsp index a37b6b59..3f21724b 100644 --- a/contemplate.lsp +++ b/contemplate.lsp @@ -15,8 +15,8 @@ (in-package :cl-user) -;; Though Clozure / CCL runs lisp-koans on the command line using -;; "ccl -l contemplate.lsp", the following lines are needed to +;; Though Clozure / CCL runs lisp-koans on the command line using +;; "ccl -l contemplate.lsp", the following lines are needed to ;; meditate on the koans within the CCL IDE. ;; (The :hemlock is used to distiguish between ccl commandline and the IDE) #+(and :ccl :hemlock) diff --git a/koans/asserts.lsp b/koans/asserts.lsp index ffcd9763..806ac3a6 100644 --- a/koans/asserts.lsp +++ b/koans/asserts.lsp @@ -39,7 +39,7 @@ (assert-equal ___ "hello world")) (define-test test-true-or-false - "sometimes you will be asked to evaluate whether statements + "sometimes you will be asked to evaluate whether statements are true (t) or false (nil)" (true-or-false? ___ (equal 34 34)) (true-or-false? ___ (equal 19 78))) diff --git a/koans/mapcar-and-reduce.lsp b/koans/mapcar-and-reduce.lsp index 31c4e659..260f9069 100644 --- a/koans/mapcar-and-reduce.lsp +++ b/koans/mapcar-and-reduce.lsp @@ -17,8 +17,8 @@ of a list using mapcar." (defun times-two (x) (* x 2)) (assert-equal ____ (mapcar #'times-two '(1 2 3))) - (assert-equal ____ (mapcar #'first '((3 2 1) - ("little" "small" "tiny") + (assert-equal ____ (mapcar #'first '((3 2 1) + ("little" "small" "tiny") ("pigs" "hogs" "swine"))))) @@ -36,10 +36,10 @@ (defun WRONG-FUNCTION-1 (&rest rest) '()) (defun transpose (L) (apply #'mapcar (cons #'WRONG-FUNCTION-1 L))) (assert-equal '((1 4 7) - (2 5 8) - (3 6 9)) - (transpose '((1 2 3) - (4 5 6) + (2 5 8) + (3 6 9)) + (transpose '((1 2 3) + (4 5 6) (7 8 9)))) (assert-equal '(("these" "pretzels" "are") ("making" "me" "thirsty")) @@ -76,7 +76,7 @@ "mapcar and reduce are a powerful combination. insert the correct function names, instead of WRONG-FUNCTION-X to define an inner product." - (defun inner (x y) + (defun inner (x y) (reduce #'WRONG-FUNCTION-2 (mapcar #'WRONG-FUNCTION-3 x y))) (assert-equal 32 (inner '(1 2 3) '(4 5 6))) (assert-equal 310 (inner '(10 20 30) '(4 3 7)))) diff --git a/koans/scope-and-extent.lsp b/koans/scope-and-extent.lsp index da400c9d..edb2462d 100644 --- a/koans/scope-and-extent.lsp +++ b/koans/scope-and-extent.lsp @@ -15,7 +15,7 @@ (defun shadow-z (z) ;; reuses the symbol name z to build a return value -;; returns a list like (value-of-z, 2) +;; returns a list like (value-of-z, 2) (cons z (cons (let ((z 2)) z) nil))) diff --git a/koans/special-forms.lsp b/koans/special-forms.lsp index 225ea3a6..50709056 100644 --- a/koans/special-forms.lsp +++ b/koans/special-forms.lsp @@ -126,7 +126,7 @@ (define-test test-limits-of-case "case is not suitable for all kinds of values, because - it uses the function eql for comparisons. We will explore + it uses the function eql for comparisons. We will explore the implications of this in the equality-distinctions lesson" (let* ((name "John") (lastname (case name ("John" "Doe") diff --git a/koans/threads.lsp b/koans/threads.lsp index 4d20a4d4..cfce24dc 100644 --- a/koans/threads.lsp +++ b/koans/threads.lsp @@ -12,8 +12,8 @@ ;; See the License for the specific language governing permissions and ;; limitations under the License. -;; NOTE: This koan group uses language features specific to sbcl, that are -;; not part of the Common Lisp specification. If you are not using sbcl, +;; NOTE: This koan group uses language features specific to sbcl, that are +;; not part of the Common Lisp specification. If you are not using sbcl, ;; feel free to skip this group by removing it from '.koans' ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -80,7 +80,7 @@ ;; then it does not need to be wrapped in a list. (define-test test-sending-arguments-to-thread - (assert-equal "Hello, Buster" + (assert-equal "Hello, Buster" (sb-thread:join-thread (sb-thread:make-thread 'returns-hello-name :arguments "Buster"))) diff --git a/lisp-unit.lsp b/lisp-unit.lsp index 4bc6dba7..61a69bcf 100644 --- a/lisp-unit.lsp +++ b/lisp-unit.lsp @@ -15,22 +15,22 @@ Modifications were made to: #| Copyright (c) 2004-2005 Christopher K. Riesbeck -Permission is hereby granted, free of charge, to any person obtaining -a copy of this software and associated documentation files (the "Software"), -to deal in the Software without restriction, including without limitation -the rights to use, copy, modify, merge, publish, distribute, sublicense, -and/or sell copies of the Software, and to permit persons to whom the +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the "Software"), +to deal in the Software without restriction, including without limitation +the rights to use, copy, modify, merge, publish, distribute, sublicense, +and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: -The above copyright notice and this permission notice shall be included +The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR -OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, -ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR +OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, +ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. @@ -523,7 +523,7 @@ assertion.") (t nil))) (defun internal-assert - (type form code-thunk expected-thunk extras test) + (type form code-thunk expected-thunk extras test) "Perform the assertion and record the results." (let* ((expected (multiple-value-list (funcall expected-thunk))) (actual (multiple-value-list (funcall code-thunk))) From 681e3fd6ad96eedc3cc178107ec9fedd78bd5398 Mon Sep 17 00:00:00 2001 From: "Pascal J. Bourguignon" Date: Fri, 3 Mar 2017 15:20:06 +0100 Subject: [PATCH 029/133] Corrected package name collision problem exposed by clisp (Thanks clisp!). --- contemplate.lsp | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/contemplate.lsp b/contemplate.lsp index 3f21724b..af1998fe 100644 --- a/contemplate.lsp +++ b/contemplate.lsp @@ -54,17 +54,21 @@ ;; Functions for loading koans ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun package-name-from-group-name (group-name) + (format nil "COM.GOOGLE.LISP-KOANS.KOANS.~:@(~A~)" group-name)) + (defun load-koan-group-named (koan-group-name) ;; Creates a package for the koan-group based on koan-group-name. ;; Loads a lisp file at *koan-dir-name* / koan-group-name .lsp ;; Adds all the koans from that file to the package. - (let ((koan-file-name (concatenate 'string (string-downcase (string koan-group-name)) ".lsp"))) + (let* ((koan-file-name (concatenate 'string (string-downcase (string koan-group-name)) ".lsp")) + (koan-package-name (package-name-from-group-name koan-group-name))) (if *dp-loading* (format t "start loading ~A ~%" koan-file-name)) (in-package :lisp-koans) - (unless (find-package koan-group-name) - (make-package koan-group-name + (unless (find-package koan-package-name) + (make-package koan-package-name :use '(:common-lisp :lisp-unit #+sbcl :sb-ext))) - (setf *package* (find-package koan-group-name)) + (setf *package* (find-package koan-package-name)) (load (concatenate 'string *koan-dir-name* "/" koan-file-name)) (incf *n-total-koans* (length (list-tests))) (in-package :lisp-koans) @@ -80,7 +84,7 @@ ;; Executes the koan group, using run-koans defined in lisp-unit ;; returning a test-results object. (if *dp-loading* (format t "start running ~A ~%" koan-group-name)) - (run-koans koan-group-name)) + (run-koans (package-name-from-group-name koan-group-name))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for printing progress ;; From b74afb49bb73d076ea05c22a8ed350eb37b4e352 Mon Sep 17 00:00:00 2001 From: "Pascal J. Bourguignon" Date: Fri, 3 Mar 2017 15:35:43 +0100 Subject: [PATCH 030/133] Added examples of invocation of some other usual Common Lisp implementations. --- README.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/README.md b/README.md index 2872a34a..829bc78d 100644 --- a/README.md +++ b/README.md @@ -3,6 +3,10 @@ Getting Started From a terminal, execute your lisp interpreter on the file 'contemplate.lsp' e.g. + abcl --noinform --noinit --load contemplate.lsp --eval '(quit)' + ccl -n -l contemplate.lsp -e '(quit)' + clisp -q -norc -ansi contemplate.lsp + ecl --norc --load contemplate.lsp --eval '(quit)' sbcl --script contemplate.lsp Running on a fresh version should output the following: From d93ddba57ffe604d39e617f66059ef404bf33f47 Mon Sep 17 00:00:00 2001 From: Rowan Thorpe Date: Wed, 10 May 2017 17:50:35 +0300 Subject: [PATCH 031/133] Add missing license header on one file variables-parameters-constants.lsp was missing a license header and (at the time of this commit) had only ever been touched by the one first commit in 2013, so I added the samed header as in the other files, with the same copyright year (2013). --- koans/variables-parameters-constants.lsp | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/koans/variables-parameters-constants.lsp b/koans/variables-parameters-constants.lsp index 6d103980..ca960376 100644 --- a/koans/variables-parameters-constants.lsp +++ b/koans/variables-parameters-constants.lsp @@ -1,3 +1,17 @@ +;; 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. + (defun test-variable-assignment-with-setf () ;; the let pattern allows us to create local variables with ;; lexical scope. From 44f92222f9b565ff0c3ff66f4888c4906d789eda Mon Sep 17 00:00:00 2001 From: Rowan Thorpe Date: Thu, 11 May 2017 00:02:36 +0300 Subject: [PATCH 032/133] Fix example of invocation of ecl in README.md --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 829bc78d..10375547 100644 --- a/README.md +++ b/README.md @@ -6,7 +6,7 @@ From a terminal, execute your lisp interpreter on the file 'contemplate.lsp' e.g abcl --noinform --noinit --load contemplate.lsp --eval '(quit)' ccl -n -l contemplate.lsp -e '(quit)' clisp -q -norc -ansi contemplate.lsp - ecl --norc --load contemplate.lsp --eval '(quit)' + ecl -norc -load contemplate.lsp -eval '(quit)' sbcl --script contemplate.lsp Running on a fresh version should output the following: From 7f80cc402f709b3a80af2181f7ce23ef5665cbfc Mon Sep 17 00:00:00 2001 From: Michael Cornelius Date: Fri, 9 Jun 2017 20:29:08 -0500 Subject: [PATCH 033/133] Update ignores --- .gitignore | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index 8ccb1710..bf04c77a 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,5 @@ # ignore some editor temp files *~ .#* -.*.sw? \ No newline at end of file +.*.sw? +\#*# From a8d4b35037de754c4673dcefd516d78aba3886ac Mon Sep 17 00:00:00 2001 From: Michael Cornelius Date: Fri, 9 Jun 2017 23:24:57 -0500 Subject: [PATCH 034/133] Run test harness automatically when changes are made --- README.md | 24 ++++++++++++++++++------ meditate.sh | 44 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 62 insertions(+), 6 deletions(-) create mode 100644 meditate.sh diff --git a/README.md b/README.md index 10375547..7b3426dd 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,8 @@ -Getting Started ---------------- +# Lisp Koans + +## Getting Started + +### One-time Method From a terminal, execute your lisp interpreter on the file 'contemplate.lsp' e.g. @@ -9,6 +12,17 @@ From a terminal, execute your lisp interpreter on the file 'contemplate.lsp' e.g ecl -norc -load contemplate.lsp -eval '(quit)' sbcl --script contemplate.lsp +### Watching the Koans + +On Linux systems, the shell script `meditate.sh` can be used to +automatically 'contemplate.lsp', providing immediate feedback on +changes to the koans. From a terminal, change into the lisp-koans: + + $ cd lisp-koans + $ sh meditate.sh + +## Results of Contemplation + Running on a fresh version should output the following: ``` @@ -41,8 +55,7 @@ in the blank (____) with appropriate lisp code to make the assert pass. In order to test code, or evaluate tests interactively, students may copy and paste code into the lisp command line REPL. -Quoting the Ruby Koans instructions:: -------------------------------------- +## Quoting the Ruby Koans instructions "In test-driven development the mantra has always been, red, green, refactor. Write a failing test and run it (red), make the test pass (green), @@ -52,8 +65,7 @@ the test pass (green), then take a moment and reflect upon the test to see what it is teaching you and improve the code to better communicate its intent (refactor)." -Content -------- +## Content The Common Lisp koans are based on the python koans and ruby koans projects. Additionally, many of the tests are based on new material that is special diff --git a/meditate.sh b/meditate.sh new file mode 100644 index 00000000..fdb16f05 --- /dev/null +++ b/meditate.sh @@ -0,0 +1,44 @@ +#!/bin/bash + +if [ $# != 1 ]; then + echo "usage: sh meditate.sh " + echo " lisp implementation: one of abcl, ccl, clisp, ecl, or sbcl" + exit +fi + +choose_command_line() { + case "$1" in + 'abcl' ) + echo "abcl --noinform --noinit --load contemplate.lsp --eval '(quit)'" + ;; + 'ccl' ) + echo "ccl -n -l contemplate.lsp -e '(quit)'" + ;; + 'clisp' ) + echo "clisp -q -norc -ansi contemplate.lsp" + ;; + 'ecl' ) + echo "ecl -norc -load contemplate.lsp -eval '(quit)'" + ;; + 'sbcl' ) + echo "sbcl --script contemplate.lsp" + ;; + * ) + echo "" + exit + ;; + esac +} + +CONTEMPLATE=$(choose_command_line $1) +if [ "$CONTEMPLATE" = "" ]; then + echo "Unknown Lisp implementation." + exit +else + echo $CONTEMPLATE +fi + +$CONTEMPLATE +while inotifywait -e modify -r koans; do + $CONTEMPLATE +done From 7c79dedbd14f3f7385e409aa0ce36c5019b0b588 Mon Sep 17 00:00:00 2001 From: Michael Cornelius Date: Sat, 10 Jun 2017 09:58:02 -0500 Subject: [PATCH 035/133] Ignore backup file events Don't run the contemplate harness when a emacs creates a backup file. --- meditate.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/meditate.sh b/meditate.sh index fdb16f05..048dda85 100644 --- a/meditate.sh +++ b/meditate.sh @@ -39,6 +39,6 @@ else fi $CONTEMPLATE -while inotifywait -e modify -r koans; do +while inotifywait -e modify --exclude "\#.*\#" -q -r koans; do $CONTEMPLATE done From 0b8fef44b3afc04f96f84e02d71f4b9b276fb88b Mon Sep 17 00:00:00 2001 From: Michael Cornelius Date: Tue, 13 Jun 2017 14:51:52 -0500 Subject: [PATCH 036/133] Improve awkward wording and fix typos... --- README.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 7b3426dd..8147104c 100644 --- a/README.md +++ b/README.md @@ -15,8 +15,9 @@ From a terminal, execute your lisp interpreter on the file 'contemplate.lsp' e.g ### Watching the Koans On Linux systems, the shell script `meditate.sh` can be used to -automatically 'contemplate.lsp', providing immediate feedback on -changes to the koans. From a terminal, change into the lisp-koans: +automatically evaluate 'contemplate.lsp' whenever the koan files are +modified, providing immediate feedback on changes to the koans. From a +terminal: $ cd lisp-koans $ sh meditate.sh From 6eb59d08720c27228038ee74305ff9ec612237ee Mon Sep 17 00:00:00 2001 From: Rowan Thorpe Date: Thu, 11 May 2017 00:23:58 +0300 Subject: [PATCH 037/133] Make confusingly prefilled let-form consistent with others --- koans/special-forms.lsp | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/koans/special-forms.lsp b/koans/special-forms.lsp index 50709056..e9959fed 100644 --- a/koans/special-forms.lsp +++ b/koans/special-forms.lsp @@ -83,13 +83,15 @@ (setf a 100) (setf b 23) (setf c 456) - (let ((a 0) + (let ((a __) (b __) (c __)) (assert-equal a 100) (assert-equal b 200) (assert-equal c "Jellyfish")) - (let* ((a 0)) + (let* ((a __) + ;; add more here + ) (assert-equal a 121) (assert-equal b 200) (assert-equal c (+ a (/ b a))))) From c866903d8234cb268532b89d6beead34d7548941 Mon Sep 17 00:00:00 2001 From: Rowan Thorpe Date: Thu, 11 May 2017 00:48:08 +0300 Subject: [PATCH 038/133] Fix docstrings to accomodate clisp clisp doesn't like multiple docstrings in a row, so fix some. --- koans/evaluation.lsp | 4 ++-- koans/iteration.lsp | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/koans/evaluation.lsp b/koans/evaluation.lsp index 97eacda4..a6505846 100644 --- a/koans/evaluation.lsp +++ b/koans/evaluation.lsp @@ -47,8 +47,8 @@ but evaluating the form '(+ 1 2) returns the list (+ 1 2)" (assert-equal ____ (+ 1 2)) (assert-equal ____ '(+ 1 2)) - "'LISTP' is a predicate which returns true if the argument is a list" - " the '(CONTENTS) form defines a list literal containing CONTENTS" + "'LISTP' is a predicate which returns true if the argument is a list + the '(CONTENTS) form defines a list literal containing CONTENTS" (assert-equal ___ (listp '(1 2 3))) (assert-equal ___ (listp 100)) (assert-equal ___ (listp "Word to your moms I came to drop bombs")) diff --git a/koans/iteration.lsp b/koans/iteration.lsp index b9cdbf83..61364c6f 100644 --- a/koans/iteration.lsp +++ b/koans/iteration.lsp @@ -34,8 +34,8 @@ (assert-equal ___ how-many-in-list) (assert-equal ___ biggest-in-list)) (let ((sum 0)) - "write your own dolist here to calculate the sum of some-primes" - "you may be interested in investigating the 'incf' function" + "write your own dolist here to calculate the sum of some-primes + you may be interested in investigating the 'incf' function" ;(dolist ... ) (assert-equal 999607602 sum))) From 441280e025e7e23f5e22f6482918edb52b1efce9 Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Sun, 10 Dec 2017 03:29:38 +0900 Subject: [PATCH 039/133] Add koans on CLOS standard method combination * koans/std-method-comb.lsp: Add new file * .koans: List new file. * koans/clos.lsp: Delete TODO comentary. --- .koans | 1 + koans/clos.lsp | 4 - koans/std-method-comb.lsp | 174 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 175 insertions(+), 4 deletions(-) create mode 100644 koans/std-method-comb.lsp diff --git a/.koans b/.koans index 7e599d00..d99f7344 100644 --- a/.koans +++ b/.koans @@ -23,6 +23,7 @@ :format :type-checking :clos + :std-method-comb :dice-project :macros :scope-and-extent diff --git a/koans/clos.lsp b/koans/clos.lsp index f3c4a72d..8e206983 100644 --- a/koans/clos.lsp +++ b/koans/clos.lsp @@ -175,7 +175,3 @@ (assert-equal ____ *last-kind-accessor*) (get-kind my-circled-color) (assert-equal ____ *last-kind-accessor*))) - - -;; Todo: consider adding :before and :after method control instructions. - diff --git a/koans/std-method-comb.lsp b/koans/std-method-comb.lsp new file mode 100644 index 00000000..428678f8 --- /dev/null +++ b/koans/std-method-comb.lsp @@ -0,0 +1,174 @@ +;; 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. + +;; In CLOS we have primary methods and auxiliary methods. +;; By default, methods are primary. +;; An auxiliary method is a method with a qualifier +;; `:before', `:after' or `:around'. +;; +;; The order of evaluation is as follows: +;; First call :before methods from most specific to least specific. +;; Second call the most specific primary method. +;; Finaly call :after methods from least specific to most specific. +;; +;; In other words: +;; The :before methods are run in most-specific-first order while +;; the :after methods are run in least-specific-first order. +;; The most specific primary method is called after the :before methods +;; and before the :after methods. +;; +;; If only primary methods are used and there is no `call-next-method' +;; calls, only the most specific method is invoked; that is, +;; more specific methods shadow more general ones. +;; http://www.lispworks.com/documentation/HyperSpec/Body/07_ffb.htm + +(defclass person () + ((words :accessor words :initform ()))) + +(defmacro pushback (elt seq) + `(setf ,seq (append ,seq (list ,elt)))) + +(defgeneric talk (obj)) +(defmethod talk ((obj person)) + (print "[person] A person is an individual of the species homo sapiens.") + (pushback 'homo-sapiens (words obj)) nil) + +(defmethod talk :before ((obj person)) + (print "[person :before] A person can talk.") + (pushback 'talk (words obj)) nil) + +(defmethod talk :after ((obj person)) + (print "[person :after] A person can code.") + (pushback 'code (words obj)) nil) + +(define-test test-std-method-combination + (let ((obj (make-instance 'person))) + (talk obj) + (assert-equal '(____ ____ ____) (words obj)))) + +;; The standard method combination follows the order: +;; First the :before methods in most-specific-first order. +;; Then evaluate the most specific primary method. +;; Finally the :after methods in least-specific-first order. +(defclass developer (person) + ((code :accessor code + :initarg :code + :initform "python"))) + +(defmethod talk ((obj developer)) + (print "[dev] A developer is a person who write code for a living.") + (pushback 'living (words obj))) + +(define-test test-std-method-combination-override + (let ((obj (make-instance 'developer))) + (talk obj) + (assert-equal '(____ ____ ____) (words obj)))) + + +;; By default the only primary method run is the most specific. +;; You can force to run the primary method of the super class (a.k.a +;; the parent class) by calling `call-next-method'. +(defclass old-school-developer (developer) ()) +(defmethod talk ((obj old-school-developer)) + (print "[old-school-dev] Old school developers don't use IDE's") + (pushback 'ide (words obj)) + (call-next-method) nil) + +(define-test test-std-method-combination-old-school + (let ((obj (make-instance 'old-school-developer))) + (talk obj) + (assert-equal '(____ ____ ____ ____) (words obj)))) + +;; A subclass with auxiliar methods doesn't override the +;; :before/:after auxiliar methods of the super class; all +;; these methods are evaluated. +(defclass cl-developer (developer) ()) +(defmethod talk :before ((obj cl-developer)) + (print + (format nil "[cl-dev :before] I do write ~a code sometimes..." + (code obj))) + (pushback 'python (words obj))) + +(defmethod talk :after ((obj cl-developer)) + (setf (code obj) "CL") + (print + (format nil "[cl-dev :after] ...and I do write ~a code most of the time :-)" + (code obj))) + (pushback 'CL (words obj))) + +(define-test test-std-method-combination-override-2 + (let ((obj (make-instance 'cl-developer))) + (talk obj) + (assert-equal '(____ ____ ____ ____ ____) (words obj)))) + +;; By default, if an auxiliar method has the keyword :around, then +;; this is the only method executed. +(defclass casual-developer (developer) + ((clothes :reader clothes :initform (list 'trouser 't-shirt)))) + +(defmethod talk :around ((obj casual-developer)) + (print "[casual-dev :around] Usually, developers like to dress casual.") + (pushback 'casual (words obj))) + +(define-test test-std-method-combination-around + (let ((obj (make-instance 'casual-developer))) + (talk obj) + (assert-equal '(____) (words obj)))) + +;; You can use `call-next-method' within an :around +;; method to force the execution of less specific methods. +(defclass good-developer (casual-developer) + ((prop :reader prop :initform 'do-tests))) + +(defmethod talk :around ((obj good-developer)) + (print "[good-dev :around] Good develpers write tests for all their functions.") + (pushback 'tests (words obj)) + (call-next-method)) + +(define-test test-std-method-combination-around-2 + (let ((obj (make-instance 'good-developer))) + (talk obj) + (assert-equal '(____ ____) (words obj)))) + +;; You can use `call-next-method' as many times as you like. +(defclass bad-developer (casual-developer) + ((prop :reader prop :initform 'lazy))) + +(defmethod talk :around ((obj bad-developer)) + (print "[bad-dev :around] Bad developers are lazy.") + (pushback 'lazy (words obj)) + (call-next-method) ; Call :around method from `casual-developer'. + (call-next-method)) ; Again. + +(define-test test-std-method-combination-around-3 + (let ((obj (make-instance 'bad-developer))) + (talk obj) + (assert-equal '(____ ____ ____) (words obj)))) + +;; ---- +(defclass rich-developer (developer) ()) +(defmethod talk :around ((obj rich-developer)) + (print "[rich-dev :around] Rich developers has lot of money." ) + (pushback 'money (words obj)) + ;; Call auxiliar methods from `person' and primary from `developer'. + (call-next-method) + (call-next-method)) ; Again. + +(define-test test-std-method-combination-around-4 + (let ((obj (make-instance 'rich-developer))) + (talk obj) + (assert-equal + '(____ ____ ____ ____ ____ ____ ____) + (words obj)))) + From c9e209e02d1ea643bad80cc3b9947773428b2849 Mon Sep 17 00:00:00 2001 From: Jasper Pilgrim Date: Sun, 6 May 2018 12:35:26 -0500 Subject: [PATCH 040/133] Fix capitalization --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 8147104c..85c37289 100644 --- a/README.md +++ b/README.md @@ -68,7 +68,7 @@ intent (refactor)." ## Content -The Common Lisp koans are based on the python koans and ruby koans projects. +The Common Lisp koans are based on the Python koans and Ruby koans projects. Additionally, many of the tests are based on new material that is special to Common Lisp. From 2601f47e14c77c9c023fe4753ac34f5fb702db41 Mon Sep 17 00:00:00 2001 From: Alexander Lazarov Date: Tue, 8 May 2018 21:18:01 +0300 Subject: [PATCH 041/133] Create a MacOS version of the mediate.sh script --- README.md | 12 +++++---- meditate.sh => mediate-linux.sh | 0 mediate-macos.sh | 45 +++++++++++++++++++++++++++++++++ 3 files changed, 52 insertions(+), 5 deletions(-) rename meditate.sh => mediate-linux.sh (100%) create mode 100644 mediate-macos.sh diff --git a/README.md b/README.md index 85c37289..c6fca0f5 100644 --- a/README.md +++ b/README.md @@ -14,13 +14,15 @@ From a terminal, execute your lisp interpreter on the file 'contemplate.lsp' e.g ### Watching the Koans -On Linux systems, the shell script `meditate.sh` can be used to -automatically evaluate 'contemplate.lsp' whenever the koan files are -modified, providing immediate feedback on changes to the koans. From a -terminal: +On Linux and MacOS systems, the shell scripts `meditate-linux.sh` and +`mediate-macos.sh` can be used to automatically evaluate 'contemplate.lsp' +whenever the koan files are modified, providing immediate feedback on changes +to the koans. To run the MacOS version you need to have +[`fswatch`](https://github.com/emcrisostomo/fswatch) installed. From a terminal: $ cd lisp-koans - $ sh meditate.sh + $ sh meditate-linux.sh # on Linux + $ sh mediate-macos.sh # on MacOS ## Results of Contemplation diff --git a/meditate.sh b/mediate-linux.sh similarity index 100% rename from meditate.sh rename to mediate-linux.sh diff --git a/mediate-macos.sh b/mediate-macos.sh new file mode 100644 index 00000000..77a29269 --- /dev/null +++ b/mediate-macos.sh @@ -0,0 +1,45 @@ +#!/bin/bash + +if [ $# != 1 ]; then + echo "usage: sh meditate.sh " + echo " lisp implementation: one of abcl, ccl, clisp, ecl, or sbcl" + exit +fi + +choose_command_line() { + case "$1" in + 'abcl' ) + echo "abcl --noinform --noinit --load contemplate.lsp --eval '(quit)'" + ;; + 'ccl' ) + echo "ccl -n -l contemplate.lsp -e '(quit)'" + ;; + 'clisp' ) + echo "clisp -q -norc -ansi contemplate.lsp" + ;; + 'ecl' ) + echo "ecl -norc -load contemplate.lsp -eval '(quit)'" + ;; + 'sbcl' ) + echo "sbcl --script contemplate.lsp" + ;; + * ) + echo "" + exit + ;; + esac +} + +CONTEMPLATE=$(choose_command_line $1) +if [ "$CONTEMPLATE" = "" ]; then + echo "Unknown Lisp implementation." + exit +else + echo $CONTEMPLATE +fi + +$CONTEMPLATE +# while inotifywait -e modify --exclude "\#.*\#" -q -r koans; do +while fswatch --exclude "\#.*\#" -r1 koans; do + $CONTEMPLATE +done From 5ff37c64975fc730313bc3c9dc16f060cd38329c Mon Sep 17 00:00:00 2001 From: Alexander Lazarov Date: Tue, 8 May 2018 21:24:23 +0300 Subject: [PATCH 042/133] Remove a commented out line --- mediate-macos.sh | 1 - 1 file changed, 1 deletion(-) diff --git a/mediate-macos.sh b/mediate-macos.sh index 77a29269..5134c650 100644 --- a/mediate-macos.sh +++ b/mediate-macos.sh @@ -39,7 +39,6 @@ else fi $CONTEMPLATE -# while inotifywait -e modify --exclude "\#.*\#" -q -r koans; do while fswatch --exclude "\#.*\#" -r1 koans; do $CONTEMPLATE done From 0d4993a25c362258e224f6829421d1f752c842b0 Mon Sep 17 00:00:00 2001 From: Alexander Lazarov Date: Sun, 19 Aug 2018 11:33:04 +0300 Subject: [PATCH 043/133] Fix an accidential rewording in the previous commit --- README.md | 2 +- mediate-linux.sh => meditate-linux.sh | 0 mediate-macos.sh => meditate-macos.sh | 0 3 files changed, 1 insertion(+), 1 deletion(-) rename mediate-linux.sh => meditate-linux.sh (100%) rename mediate-macos.sh => meditate-macos.sh (100%) diff --git a/README.md b/README.md index c6fca0f5..22ce85ed 100644 --- a/README.md +++ b/README.md @@ -15,7 +15,7 @@ From a terminal, execute your lisp interpreter on the file 'contemplate.lsp' e.g ### Watching the Koans On Linux and MacOS systems, the shell scripts `meditate-linux.sh` and -`mediate-macos.sh` can be used to automatically evaluate 'contemplate.lsp' +`meditate-macos.sh` can be used to automatically evaluate 'contemplate.lsp' whenever the koan files are modified, providing immediate feedback on changes to the koans. To run the MacOS version you need to have [`fswatch`](https://github.com/emcrisostomo/fswatch) installed. From a terminal: diff --git a/mediate-linux.sh b/meditate-linux.sh similarity index 100% rename from mediate-linux.sh rename to meditate-linux.sh diff --git a/mediate-macos.sh b/meditate-macos.sh similarity index 100% rename from mediate-macos.sh rename to meditate-macos.sh From 6ad4f5513e2fd0a306b7889db4245e531b25e3eb Mon Sep 17 00:00:00 2001 From: Alexander Lazarov Date: Sun, 19 Aug 2018 11:35:05 +0300 Subject: [PATCH 044/133] Fix a wording change that I missed in the previous commit --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 22ce85ed..9e61a04e 100644 --- a/README.md +++ b/README.md @@ -22,7 +22,7 @@ to the koans. To run the MacOS version you need to have $ cd lisp-koans $ sh meditate-linux.sh # on Linux - $ sh mediate-macos.sh # on MacOS + $ sh meditate-macos.sh # on MacOS ## Results of Contemplation From 222c699cd1a22266f02edff3c1176b5436331b79 Mon Sep 17 00:00:00 2001 From: gloomgarden <2458684+gloomgarden@users.noreply.github.com> Date: Thu, 23 Aug 2018 00:27:40 -0400 Subject: [PATCH 045/133] Fix regex compilation error in meditate-macos.sh's fswatch call --- meditate-macos.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/meditate-macos.sh b/meditate-macos.sh index 5134c650..8ac0116c 100644 --- a/meditate-macos.sh +++ b/meditate-macos.sh @@ -39,6 +39,6 @@ else fi $CONTEMPLATE -while fswatch --exclude "\#.*\#" -r1 koans; do +while fswatch --exclude '#.*#' -r1 koans; do $CONTEMPLATE done From 6d31e005bf421197c33a29fa769422e14ea046e6 Mon Sep 17 00:00:00 2001 From: jgodbout Date: Fri, 9 Aug 2019 10:32:38 -0400 Subject: [PATCH 046/133] Lisp-koans currently uses sbcl specific thraeding libraries for it threads koan. Bordeaux threads is the standard API for lisp threading, so thats what should be uses. Make it so. PiperOrigin-RevId: 262556702 --- .gitignore | 5 -- BUILD | 5 ++ METADATA | 15 ++++ README.md | 10 ++- TODO | 3 - copy.bara.sky | 7 ++ koans/threads.lsp | 178 ++++++++++++++++++++++++---------------------- 7 files changed, 126 insertions(+), 97 deletions(-) delete mode 100644 .gitignore create mode 100644 BUILD create mode 100644 METADATA create mode 100644 copy.bara.sky diff --git a/.gitignore b/.gitignore deleted file mode 100644 index bf04c77a..00000000 --- a/.gitignore +++ /dev/null @@ -1,5 +0,0 @@ -# ignore some editor temp files -*~ -.#* -.*.sw? -\#*# diff --git a/BUILD b/BUILD new file mode 100644 index 00000000..bf87c5fb --- /dev/null +++ b/BUILD @@ -0,0 +1,5 @@ +# Description: Common Lisp lisp-koans + +licenses(["notice"]) # Apache License 2.0 at //third_party/lisp/lisp-koans/LICENSE + +exports_files(["LICENSE"]) diff --git a/METADATA b/METADATA new file mode 100644 index 00000000..e1bbfcec --- /dev/null +++ b/METADATA @@ -0,0 +1,15 @@ +name: "My Project" +description: "Common Lisp Koans is a language learning exercise in the same vein as the ruby koans, python koans and others. It is a port of the prior koans with some modifications to highlight lisp-specific features. Structured as ordered groups of broken unit tests, the project guides the learner progressively through many Common Lisp language features." + +third_party { + url { + type: GIT + value: "https://github.com/google/lisp-koans" + } + version: "35a520021fab4393b2565dd42ca9e626ac0951b7" + last_upgrade_date { + year: 2019 + month: 8 + day: 7 + } +} diff --git a/README.md b/README.md index 9e61a04e..69ec3dd8 100644 --- a/README.md +++ b/README.md @@ -74,5 +74,11 @@ The Common Lisp koans are based on the Python koans and Ruby koans projects. Additionally, many of the tests are based on new material that is special to Common Lisp. -Note that the unit on threads uses an SBCL specific threading API. A reader -macro will remove this unit on Lisp implementations other than SBCL. +Note that the unit on threads uses bordeaux-threads and bt-semaphore. +The user must have quicklisp installed and loaded or a reader macro +will remove the isntruction to run :threads. +For instructions on installing quicklisp please see: +https://lisp-lang.org/learn/getting-started/ +The user can either remove #+quicklisp and uncomment +(load "~/.quicklisp/setup.lisp") in threads.lsp, or if they know +quicklisp will be loaded while running contemplate.lsp do nothing. diff --git a/TODO b/TODO index 5d81a3f4..8731fbc0 100644 --- a/TODO +++ b/TODO @@ -1,7 +1,4 @@ -* replace koans/threads.lsp with a more general thread library * make get-error-filename more maintainable * make get-error-koan-name more maintainable * make get-error-koan-status more maintainable * improve error reporting from "a koan threw an error" to something more helpful - - diff --git a/copy.bara.sky b/copy.bara.sky new file mode 100644 index 00000000..58a85d8e --- /dev/null +++ b/copy.bara.sky @@ -0,0 +1,7 @@ +load("//devtools/copybara/library/workflow", "exclude_paths", "git_to_third_party") + +git_to_third_party( + url = "https://github.com/google/lisp-koans", + git_files = exclude_paths([".gitignore"]), + google3_path = "third_party/lisp/lisp-koans", +) diff --git a/koans/threads.lsp b/koans/threads.lsp index cfce24dc..e18b72f8 100644 --- a/koans/threads.lsp +++ b/koans/threads.lsp @@ -12,21 +12,26 @@ ;; See the License for the specific language governing permissions and ;; limitations under the License. -;; NOTE: This koan group uses language features specific to sbcl, that are -;; not part of the Common Lisp specification. If you are not using sbcl, -;; feel free to skip this group by removing it from '.koans' +;; NOTE: This koan group uses quicklisp to load packages that are +;; not part of the Common Lisp specification. +;; If you are using quicklisp please feel free to enable this group +;; by following the instructions in the README. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Making threads with sb-thread:make-thread ;; -;; Joining threads with sb-thread:join-thread ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Making threads with bordeaux-threads:make-thread ;; +;; Joining threads with bordeaux-threads:join-thread ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; sb-thread takes a -function- as a parameter. +;; bordeaux-threads takes a -function- as a parameter. ;; This function will be executed in a separate thread. ;; Since the execution order of separate threads is not guaranteed, ;; we must -join- the threads in order to make our assertions. +;; (load "~/.quicklisp/setup.lisp") +(ql:quickload :bordeaux-threads) +(ql:quickload :bt-semaphore) + (defvar *greeting* "no greeting") (defun sets-socal-greeting () @@ -37,30 +42,30 @@ using a lambda as the supplied function to execute." (assert-equal *greeting* "no greeting") (let ((greeting-thread - (sb-thread:make-thread + (bordeaux-threads:make-thread (lambda () (setf *greeting* "hello world"))))) - (sb-thread:join-thread greeting-thread) + (bordeaux-threads:join-thread greeting-thread) (assert-equal *greeting* "hello world") - (setf greeting-thread (sb-thread:make-thread #'sets-socal-greeting)) - (sb-thread:join-thread greeting-thread) + (setf greeting-thread (bordeaux-threads:make-thread #'sets-socal-greeting)) + (bordeaux-threads:join-thread greeting-thread) (assert-equal *greeting* ____))) (define-test test-join-thread-return-value - "the return value of the thread is passed in sb-thread:join-thread" - (let ((my-thread (sb-thread:make-thread + "the return value of the thread is passed in bordeaux-threads:join-thread" + (let ((my-thread (bordeaux-threads:make-thread (lambda () (* 11 99))))) - (assert-equal ____ (sb-thread:join-thread my-thread)))) + (assert-equal ____ (bordeaux-threads:join-thread my-thread)))) (define-test test-threads-can-have-names "Threads can have names. Names can be useful in diagnosing problems or reporting." (let ((empty-plus-thread - (sb-thread:make-thread #'+ + (bordeaux-threads:make-thread #'+ :name "what is the sum of no things adding?"))) - (assert-equal (sb-thread:thread-name empty-plus-thread) + (assert-equal (bordeaux-threads:thread-name empty-plus-thread) ____))) @@ -74,20 +79,21 @@ (defun double-wrap-list (x y z) (list (list x y z))) -;; Create a thread which will return "Hello -Name-" using -;; the named returns-hello-name function. Arguments are handed -;; to threads as a list, unless there is just a single argument -;; then it does not need to be wrapped in a list. +;; Create a thread which will print out "Hello -Name-" using +;; the named write-hello-name function. Arguments and functions +;; are handed to threads in a lambda. (define-test test-sending-arguments-to-thread (assert-equal "Hello, Buster" - (sb-thread:join-thread - (sb-thread:make-thread 'returns-hello-name - :arguments "Buster"))) - (assert-equal ____ - (sb-thread:join-thread - (sb-thread:make-thread 'double-wrap-list - :arguments '(3 4 5))))) + (bordeaux-threads:join-thread + (bordeaux-threads:make-thread + #'(lambda () + (returns-hello-name "Buster"))))) + (assert-equal ____ + (bordeaux-threads:join-thread + (bordeaux-threads:make-thread + #'(lambda () + (double-wrap-list 3 4 5)))))) ;; ---- @@ -122,12 +128,12 @@ "same program as above, executed in threads. Sleeps are simultaneous" (setf *accum* 0) (setf *before-time-millisec* (get-internal-real-time)) - (let ((thread-1 (sb-thread:make-thread 'accum-after-time :arguments '(0.3 1))) - (thread-2 (sb-thread:make-thread 'accum-after-time :arguments '(0.2 2))) - (thread-3 (sb-thread:make-thread 'accum-after-time :arguments '(0.1 4)))) - (sb-thread:join-thread thread-1) - (sb-thread:join-thread thread-2) - (sb-thread:join-thread thread-3)) + (let ((thread-1 (bordeaux-threads:make-thread #'(lambda () (accum-after-time 0.3 1)))) + (thread-2 (bordeaux-threads:make-thread #'(lambda () (accum-after-time 0.2 2)))) + (thread-3 (bordeaux-threads:make-thread #'(lambda () (accum-after-time 0.1 4))))) + (bordeaux-threads:join-thread thread-1) + (bordeaux-threads:join-thread thread-2) + (bordeaux-threads:join-thread thread-3)) (setf *after-time-millisec* (get-internal-real-time)) (true-or-false? ___ (> (duration-ms) 200)) (true-or-false? ___ (< (duration-ms) 400)) @@ -141,22 +147,24 @@ (defun spawn-looping-thread (name) "create a never-ending looping thread with a given name" - (sb-thread:make-thread (lambda () (loop)) :name name)) + (bordeaux-threads:make-thread (lambda () (loop)) :name name)) -(defvar *top-thread* sb-thread:*current-thread*) -(defun main-thread-p (thread) (eq thread *top-thread*)) +(defun main-thread-p (thread) + (string-equal (bordeaux-threads:thread-name thread) + "Main Thread")) (defun kill-thread-if-not-main (thread) " kills a given thread, unless the thread is the main thread. returns nil if thread is main. returns a 'terminated~' string otherwise" - (unless (main-thread-p thread) - (sb-thread:terminate-thread thread) - (concatenate 'string "terminated " (sb-thread:thread-name thread)))) + (unless (string-equal (bordeaux-threads:thread-name thread) + "Main Thread") + (bordeaux-threads:destroy-thread thread) + (concatenate 'string "terminated " (bordeaux-threads:thread-name thread)))) (defun kill-spawned-threads () "kill all lisp threads except the main thread." - (map 'list 'kill-thread-if-not-main (sb-thread:list-all-threads))) + (map 'list 'kill-thread-if-not-main (bordeaux-threads:all-threads))) (defun spawn-three-loopers () "Spawn three run-aways." @@ -166,18 +174,18 @@ (spawn-looping-thread "looper three"))) (define-test test-counting-and-killing-threads - "list-all-threads makes a list of all running threads in this lisp. The sleep + "all-threads makes a list of all running threads in this lisp. The sleep calls are necessary, as killed threads are not instantly removed from the list of all running threads." - (assert-equal ___ (length (sb-thread:list-all-threads))) + (assert-equal ___ (length (bordeaux-threads:all-threads))) (kill-thread-if-not-main (spawn-looping-thread "NEVER CATCH ME~! NYA NYA!")) (sleep 0.01) - (assert-equal ___ (length (sb-thread:list-all-threads))) + (assert-equal ___ (length (bordeaux-threads:all-threads))) (spawn-three-loopers) - (assert-equal ___ (length (sb-thread:list-all-threads))) + (assert-equal ___ (length (bordeaux-threads:all-threads))) (kill-spawned-threads) (sleep 0.01) - (assert-equal ___ (length (sb-thread:list-all-threads)))) + (assert-equal ___ (length (bordeaux-threads:all-threads)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -191,13 +199,13 @@ (define-test test-threads-dont-get-bindings "bindings are not inherited across threads" - (let ((thread-ret-val (sb-thread:join-thread - (sb-thread:make-thread 'returns-v)))) + (let ((thread-ret-val (bordeaux-threads:join-thread + (bordeaux-threads:make-thread 'returns-v)))) (assert-equal thread-ret-val ____)) (let ((*v* "LEXICAL BOUND VALUE")) (assert-equal *v* ____) - (let ((thread-ret-val (sb-thread:join-thread - (sb-thread:make-thread 'returns-v)))) + (let ((thread-ret-val (bordeaux-threads:join-thread + (bordeaux-threads:make-thread 'returns-v)))) (assert-equal thread-ret-val ____)))) @@ -226,12 +234,12 @@ (define-test test-parallel-wait-and-increment (setf *g* 0) - (let ((thread-1 (sb-thread:make-thread 'waits-and-increments-g)) - (thread-2 (sb-thread:make-thread 'waits-and-increments-g)) - (thread-3 (sb-thread:make-thread 'waits-and-increments-g))) - (sb-thread:join-thread thread-1) - (sb-thread:join-thread thread-2) - (sb-thread:join-thread thread-3) + (let ((thread-1 (bordeaux-threads:make-thread 'waits-and-increments-g)) + (thread-2 (bordeaux-threads:make-thread 'waits-and-increments-g)) + (thread-3 (bordeaux-threads:make-thread 'waits-and-increments-g))) + (bordeaux-threads:join-thread thread-1) + (bordeaux-threads:join-thread thread-2) + (bordeaux-threads:join-thread thread-3) (assert-equal *g* ___))) @@ -241,23 +249,23 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setf *g* 0) -(defvar *gs-mutex* (sb-thread:make-mutex :name "g's lock")) +(defvar *gs-mutex* (bordeaux-threads:make-lock "g's lock")) (defun protected-increments-g (&optional (n 0.1)) "Surround all references to *g* within the with-mutex form." - (sb-thread:with-mutex (*gs-mutex*) + (bordeaux-threads:with-lock-held (*gs-mutex*) (let ((my-remembered-g *g*)) (sleep n) (setq *g* (+ 1 my-remembered-g))))) (define-test test-parallel-wait-and-increment-with-mutex (setf *g* 0) - (let ((thread-1 (sb-thread:make-thread 'protected-increments-g)) - (thread-2 (sb-thread:make-thread 'protected-increments-g)) - (thread-3 (sb-thread:make-thread 'protected-increments-g))) - (sb-thread:join-thread thread-1) - (sb-thread:join-thread thread-2) - (sb-thread:join-thread thread-3) + (let ((thread-1 (bordeaux-threads:make-thread 'protected-increments-g)) + (thread-2 (bordeaux-threads:make-thread 'protected-increments-g)) + (thread-3 (bordeaux-threads:make-thread 'protected-increments-g))) + (bordeaux-threads:join-thread thread-1) + (bordeaux-threads:join-thread thread-2) + (bordeaux-threads:join-thread thread-3) (assert-equal *g* ___))) ;;;;;;;;;;;;;;;; @@ -265,52 +273,48 @@ ;;;;;;;;;;;;;;;; ;; Incrementing a semaphore is an atomic operation. -(defvar *g-semaphore* (sb-thread:make-semaphore :name "g" :count 0)) +(defvar *g-semaphore* (bordeaux-threads:make-semaphore :name "g" :count 0)) (defun semaphore-increments-g () - (sb-thread:signal-semaphore *g-semaphore*)) + (bordeaux-threads:signal-semaphore *g-semaphore*)) (define-test test-increment-semaphore - (assert-equal 0 (sb-thread:semaphore-count *g-semaphore*)) - (sb-thread:join-thread (sb-thread:make-thread 'semaphore-increments-g :name "S incrementor 1")) - (sb-thread:join-thread (sb-thread:make-thread 'semaphore-increments-g :name "S incrementor 2")) - (sb-thread:join-thread (sb-thread:make-thread 'semaphore-increments-g :name "S incrementor 3")) - (assert-equal ___ (sb-thread:semaphore-count *g-semaphore*))) + (assert-equal 0 (bt-semaphore:semaphore-count *g-semaphore*)) + (bordeaux-threads:join-thread (bordeaux-threads:make-thread 'semaphore-increments-g :name "S incrementor 1")) + (bordeaux-threads:join-thread (bordeaux-threads:make-thread 'semaphore-increments-g :name "S incrementor 2")) + (bordeaux-threads:join-thread (bordeaux-threads:make-thread 'semaphore-increments-g :name "S incrementor 3")) + (assert-equal ___ (bt-semaphore:semaphore-count *g-semaphore*))) ;; Semaphores can be used to manage resource allocation, and to trigger ;; threads to run when the semaphore value is above zero. -(defvar *apples* (sb-thread:make-semaphore :name "how many apples" :count 0)) +(defvar *apples* (bt-semaphore:make-semaphore :name "how many apples" :count 0)) (defvar *orchard-log* (make-array 10)) -(defvar *next-log-idx* 0) -(defvar *orchard-log-mutex* (sb-thread:make-mutex :name "orchard log mutex")) +(defvar *next-log-entry* 0) +(defvar *orchard-log-mutex* (bordeaux-threads:make-lock "orchard log mutex")) (defun add-to-log (item) - (sb-thread:with-mutex (*orchard-log-mutex*) - (setf (aref *orchard-log* *next-log-idx*) item) - (incf *next-log-idx*))) + (bordeaux-threads:with-lock-held (*orchard-log-mutex*) + (setf (aref *orchard-log* *next-log-entry*) item) + (incf *next-log-entry*))) (defun apple-eater () - (sb-thread:wait-on-semaphore *apples*) + (bt-semaphore:wait-on-semaphore *apples*) (add-to-log "apple eaten.")) (defun apple-grower () (sleep 0.1) (add-to-log "apple grown.") - (sb-thread:signal-semaphore *apples*)) + (bt-semaphore:signal-semaphore *apples*)) (defun num-apples () - (sb-thread:semaphore-count *apples*)) + (bt-semaphore:semaphore-count *apples*)) (define-test test-orchard-simulation (assert-equal (num-apples) ___) - (let ((eater-thread (sb-thread:make-thread 'apple-eater :name "apple eater thread"))) - (let ((grower-thread (sb-thread:make-thread 'apple-grower :name "apple grower thread"))) - (sb-thread:join-thread eater-thread))) + (let ((eater-thread (bordeaux-threads:make-thread 'apple-eater :name "apple eater thread"))) + (let ((grower-thread (bordeaux-threads:make-thread 'apple-grower :name "apple grower thread"))) + (bordeaux-threads:join-thread eater-thread))) (assert-equal (aref *orchard-log* 0) ____) (assert-equal (aref *orchard-log* 1) ____)) - - - - From 448970408fbb5fedecd12b79ba684e966c168a1e Mon Sep 17 00:00:00 2001 From: Googler Date: Wed, 14 Aug 2019 09:41:49 -0400 Subject: [PATCH 047/133] Project import generated by Copybara. PiperOrigin-RevId: 263339104 --- METADATA | 15 --------------- README.md | 9 +++++---- copy.bara.sky | 43 ++++++++++++++++++++++++++++++++++++++++++- 3 files changed, 47 insertions(+), 20 deletions(-) delete mode 100644 METADATA diff --git a/METADATA b/METADATA deleted file mode 100644 index e1bbfcec..00000000 --- a/METADATA +++ /dev/null @@ -1,15 +0,0 @@ -name: "My Project" -description: "Common Lisp Koans is a language learning exercise in the same vein as the ruby koans, python koans and others. It is a port of the prior koans with some modifications to highlight lisp-specific features. Structured as ordered groups of broken unit tests, the project guides the learner progressively through many Common Lisp language features." - -third_party { - url { - type: GIT - value: "https://github.com/google/lisp-koans" - } - version: "35a520021fab4393b2565dd42ca9e626ac0951b7" - last_upgrade_date { - year: 2019 - month: 8 - day: 7 - } -} diff --git a/README.md b/README.md index 69ec3dd8..6f198ddf 100644 --- a/README.md +++ b/README.md @@ -75,10 +75,11 @@ Additionally, many of the tests are based on new material that is special to Common Lisp. Note that the unit on threads uses bordeaux-threads and bt-semaphore. -The user must have quicklisp installed and loaded or a reader macro -will remove the isntruction to run :threads. -For instructions on installing quicklisp please see: -https://lisp-lang.org/learn/getting-started/ +The user must have Quicklisp installed and loaded or a reader macro +will remove the instructions to run :threads. +For information and instructions on installing Quicklisp +please see: +https://www.quicklisp.org/beta/ The user can either remove #+quicklisp and uncomment (load "~/.quicklisp/setup.lisp") in threads.lsp, or if they know quicklisp will be loaded while running contemplate.lsp do nothing. diff --git a/copy.bara.sky b/copy.bara.sky index 58a85d8e..3b903dfe 100644 --- a/copy.bara.sky +++ b/copy.bara.sky @@ -2,6 +2,47 @@ load("//devtools/copybara/library/workflow", "exclude_paths", "git_to_third_part git_to_third_party( url = "https://github.com/google/lisp-koans", - git_files = exclude_paths([".gitignore"]), + git_files = exclude_paths([ + ".gitignore", + "METADATA", + "copy.bara.sky", + "BUILD", + ]), google3_path = "third_party/lisp/lisp-koans", ) + +def leakr_check(): + return leakr.check( + dictionary = "//third_party/py/dopamine/leakr_badwords.dic", + change_description_on_error = "Internal change", + file_type_recipe = [ + "//testing/leakr/common/recipes/default.ftrcp", + "//third_party/google_research/google/copybara/leakr_file_type_recipe.ftrcp", + ], + ) + +core.workflow( + name = "piper_to_git", + origin = piper.origin(pending_cl = True), + origin_files = glob( + include = ["google3/third_party/lisp/lisp-koans/**"], + exclude = ["google3/third_party/lisp/lisp-koans/OWNERS"], + ), + destination = git.destination( + url = "https://github.com/google/lisp-koans.git", + push = "master", + ), + mode = "CHANGE_REQUEST", + authoring = authoring.whitelisted( + default = "Googler ", + whitelist = [ + "jgodbout", + "bileschi", + ], + ), + transformations = [ + core.move("google3/third_party/lisp/lisp-koans", ""), + metadata.scrubber("^(?:\n|.)*((?:\n|.)*)(?:\n|.)*$", replacement = "$1"), + leakr.check(), + ], +) From 46fb766618ccc2e10fb7ff398a653d10aeff0a23 Mon Sep 17 00:00:00 2001 From: Jon Godbout Date: Wed, 14 Aug 2019 12:23:17 -0400 Subject: [PATCH 048/133] Update .koans Should have a reader macro for quicklisp not sb-threads --- .koans | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.koans b/.koans index 7e599d00..f50b45f1 100644 --- a/.koans +++ b/.koans @@ -26,5 +26,5 @@ :dice-project :macros :scope-and-extent - #+sb-thread :threads + #+qicklisp :threads ) From 85ff8450ac10b79594d3eaad6f0002cd2ce1e6e7 Mon Sep 17 00:00:00 2001 From: Alex Ponomarev <26557823+alxnorden@users.noreply.github.com> Date: Sun, 15 Dec 2019 11:36:04 +0100 Subject: [PATCH 049/133] Update evaluation.lsp The material referenced is no longer available directly, instead there is a link to a google drive archive. Alternatively, the book is available on amazon. I have linked to the original website with the link to amazon, in case the author decides to update the link or use a different publisher. --- koans/evaluation.lsp | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/koans/evaluation.lsp b/koans/evaluation.lsp index a6505846..47e56c7e 100644 --- a/koans/evaluation.lsp +++ b/koans/evaluation.lsp @@ -13,7 +13,10 @@ ;; limitations under the License. -;; based on http://psg.com/~dlamkins/sl/chapter03-02.html +;; Based on "Successful Lisp" by David B. Lamkins +;; Download link to archive https://successful-lisp.blogspot.com/p/httpsdrive.html +;; Or buy the Book via : https://successful-lisp.blogspot.com/ + (define-test test-function-name-is-first-argument "In most imperative languages, the syntax of a function call has From 2c757703213011461cf51bc0ea3a91ff11539dfb Mon Sep 17 00:00:00 2001 From: Pavel Kulyov Date: Thu, 26 Dec 2019 21:00:36 +0300 Subject: [PATCH 050/133] Fix typo 'qicklisp' -> 'quicklisp' --- .koans | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.koans b/.koans index f50b45f1..55ae68e2 100644 --- a/.koans +++ b/.koans @@ -26,5 +26,5 @@ :dice-project :macros :scope-and-extent - #+qicklisp :threads + #+quicklisp :threads ) From 5cf76c78d281a59aa4203ac1878ac48bfdff7089 Mon Sep 17 00:00:00 2001 From: jgodbout Date: Mon, 4 May 2020 17:06:58 -0400 Subject: [PATCH 051/133] as PiperOrigin-RevId: 309813333 --- METADATA | 15 +++++++++++++++ copy.bara.sky | 2 +- koans/threads.lsp | 47 +++++++++++++++++++++++++++++++++++++---------- 3 files changed, 53 insertions(+), 11 deletions(-) create mode 100644 METADATA diff --git a/METADATA b/METADATA new file mode 100644 index 00000000..46edd24d --- /dev/null +++ b/METADATA @@ -0,0 +1,15 @@ +name: "Lisp Koans" +description: "Common Lisp Koans is a language learning exercise in the same vein as the ruby koans, python koans and others. It is a port of the prior koans with some modifications to highlight lisp-specific features. Structured as ordered groups of broken unit tests, the project guides the learner progressively through many Common Lisp language features." + +third_party { + url { + type: GIT + value: "https://github.com/google/lisp-koans" + } + version: "5896339684fc0b2227e1b06be238aa54cfcde67a" + last_upgrade_date { + year: 2020 + month: 5 + day: 4 + } +} diff --git a/copy.bara.sky b/copy.bara.sky index 3b903dfe..ddfe0826 100644 --- a/copy.bara.sky +++ b/copy.bara.sky @@ -23,7 +23,7 @@ def leakr_check(): core.workflow( name = "piper_to_git", - origin = piper.origin(pending_cl = True), + origin = piper.origin(pending_cl = False), origin_files = glob( include = ["google3/third_party/lisp/lisp-koans/**"], exclude = ["google3/third_party/lisp/lisp-koans/OWNERS"], diff --git a/koans/threads.lsp b/koans/threads.lsp index e18b72f8..f3efa46f 100644 --- a/koans/threads.lsp +++ b/koans/threads.lsp @@ -30,7 +30,6 @@ ;; (load "~/.quicklisp/setup.lisp") (ql:quickload :bordeaux-threads) -(ql:quickload :bt-semaphore) (defvar *greeting* "no greeting") @@ -272,24 +271,52 @@ ;; Semaphores ;; ;;;;;;;;;;;;;;;; -;; Incrementing a semaphore is an atomic operation. -(defvar *g-semaphore* (bordeaux-threads:make-semaphore :name "g" :count 0)) +;; bordeaux-threads does not allow you to see +;; count on a semaphore, so we make a struct +;; to keep track of both the semaphore and count for us. + +(defstruct semaphore + (semaphore nil :type bordeaux-threads:semaphore) + (count 0 :type integer)) + +(defun make-our-semaphore (&key (count 0) (name "")) + (make-semaphore :semaphore (bordeaux-threads:make-semaphore + :count count + :name name) + :count count)) + +(defun signal-semaphore (semaphore) + (bordeaux-threads:signal-semaphore + (semaphore-semaphore semaphore)) + (incf (semaphore-count semaphore))) + +(defun wait-on-semaphore (semaphore) + (bordeaux-threads:wait-on-semaphore + (semaphore-semaphore semaphore)) + (decf (semaphore-count semaphore))) + +(defun semaphore-name (semaphore) + (semaphore-name (semaphore-semaphore semaphore))) + +;; Incrementing a bordeaux-threads semaphore is an atomic operation +;; but our increment is not. +(defvar *g-semaphore* (make-our-semaphore :name "g" :count 0)) (defun semaphore-increments-g () - (bordeaux-threads:signal-semaphore *g-semaphore*)) + (signal-semaphore *g-semaphore*)) (define-test test-increment-semaphore - (assert-equal 0 (bt-semaphore:semaphore-count *g-semaphore*)) + (assert-equal ___ (semaphore-count *g-semaphore*)) (bordeaux-threads:join-thread (bordeaux-threads:make-thread 'semaphore-increments-g :name "S incrementor 1")) (bordeaux-threads:join-thread (bordeaux-threads:make-thread 'semaphore-increments-g :name "S incrementor 2")) (bordeaux-threads:join-thread (bordeaux-threads:make-thread 'semaphore-increments-g :name "S incrementor 3")) - (assert-equal ___ (bt-semaphore:semaphore-count *g-semaphore*))) + (assert-equal ___ (semaphore-count *g-semaphore*))) ;; Semaphores can be used to manage resource allocation, and to trigger ;; threads to run when the semaphore value is above zero. -(defvar *apples* (bt-semaphore:make-semaphore :name "how many apples" :count 0)) +(defvar *apples* (make-semaphore :name "how many apples" :count 0)) (defvar *orchard-log* (make-array 10)) (defvar *next-log-entry* 0) (defvar *orchard-log-mutex* (bordeaux-threads:make-lock "orchard log mutex")) @@ -300,16 +327,16 @@ (incf *next-log-entry*))) (defun apple-eater () - (bt-semaphore:wait-on-semaphore *apples*) + (wait-on-semaphore *apples*) (add-to-log "apple eaten.")) (defun apple-grower () (sleep 0.1) (add-to-log "apple grown.") - (bt-semaphore:signal-semaphore *apples*)) + (signal-semaphore *apples*)) (defun num-apples () - (bt-semaphore:semaphore-count *apples*)) + (semaphore-count *apples*)) (define-test test-orchard-simulation (assert-equal (num-apples) ___) From 5acc0baab215124186d5e81c1add69f5bd16096b Mon Sep 17 00:00:00 2001 From: Jon Godbout Date: Mon, 4 May 2020 22:37:30 -0400 Subject: [PATCH 052/133] Delete METADATA Shouldn't have been added. --- METADATA | 15 --------------- 1 file changed, 15 deletions(-) delete mode 100644 METADATA diff --git a/METADATA b/METADATA deleted file mode 100644 index 46edd24d..00000000 --- a/METADATA +++ /dev/null @@ -1,15 +0,0 @@ -name: "Lisp Koans" -description: "Common Lisp Koans is a language learning exercise in the same vein as the ruby koans, python koans and others. It is a port of the prior koans with some modifications to highlight lisp-specific features. Structured as ordered groups of broken unit tests, the project guides the learner progressively through many Common Lisp language features." - -third_party { - url { - type: GIT - value: "https://github.com/google/lisp-koans" - } - version: "5896339684fc0b2227e1b06be238aa54cfcde67a" - last_upgrade_date { - year: 2020 - month: 5 - day: 4 - } -} From 78ac54a255ed3e9f0072fd0a0c24d9f30b8ddc39 Mon Sep 17 00:00:00 2001 From: Jon Godbout Date: Mon, 4 May 2020 22:37:48 -0400 Subject: [PATCH 053/133] Delete copy.bara.sky --- copy.bara.sky | 48 ------------------------------------------------ 1 file changed, 48 deletions(-) delete mode 100644 copy.bara.sky diff --git a/copy.bara.sky b/copy.bara.sky deleted file mode 100644 index ddfe0826..00000000 --- a/copy.bara.sky +++ /dev/null @@ -1,48 +0,0 @@ -load("//devtools/copybara/library/workflow", "exclude_paths", "git_to_third_party") - -git_to_third_party( - url = "https://github.com/google/lisp-koans", - git_files = exclude_paths([ - ".gitignore", - "METADATA", - "copy.bara.sky", - "BUILD", - ]), - google3_path = "third_party/lisp/lisp-koans", -) - -def leakr_check(): - return leakr.check( - dictionary = "//third_party/py/dopamine/leakr_badwords.dic", - change_description_on_error = "Internal change", - file_type_recipe = [ - "//testing/leakr/common/recipes/default.ftrcp", - "//third_party/google_research/google/copybara/leakr_file_type_recipe.ftrcp", - ], - ) - -core.workflow( - name = "piper_to_git", - origin = piper.origin(pending_cl = False), - origin_files = glob( - include = ["google3/third_party/lisp/lisp-koans/**"], - exclude = ["google3/third_party/lisp/lisp-koans/OWNERS"], - ), - destination = git.destination( - url = "https://github.com/google/lisp-koans.git", - push = "master", - ), - mode = "CHANGE_REQUEST", - authoring = authoring.whitelisted( - default = "Googler ", - whitelist = [ - "jgodbout", - "bileschi", - ], - ), - transformations = [ - core.move("google3/third_party/lisp/lisp-koans", ""), - metadata.scrubber("^(?:\n|.)*((?:\n|.)*)(?:\n|.)*$", replacement = "$1"), - leakr.check(), - ], -) From c192df0cb53be8add4d189eee7d396fe41e94785 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 12:48:00 +0200 Subject: [PATCH 054/133] Change +BLANKS+ to be DEFVAR DEFCONSTANT is signaling an error when lisp-unit.lisp is reloaded. The simplest fix is to change the form to DEFVAR instead. --- lisp-unit.lsp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp-unit.lsp b/lisp-unit.lsp index 61a69bcf..95d5301b 100644 --- a/lisp-unit.lsp +++ b/lisp-unit.lsp @@ -135,7 +135,7 @@ functions or even macros does not require reloading any tests. (defconstant __ :blank-value) (defconstant ___ :blank-value) (defconstant ____ :blank-value) -(defconstant +blanks+ '(__ ___ ____)) +(defvar +blanks+ '(__ ___ ____)) (defconstant +blank-value+ 'BLANK-VALUE) From ee82bcecccac2d0afba61b6051aca5e6df8cf1a4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 13:28:40 +0200 Subject: [PATCH 055/133] Rename package LISP-UNIT to COM.GOOGLE.LISP-KOANS.TEST In order to put the koans on Quicklisp, we need to ensure that the version of lisp-unit bundled with the koans does not clash with the Quicklisp-distributed version of lisp-unit. Therefore, we rename the package. --- contemplate.lsp | 10 ++++++---- lisp-unit.lsp | 8 ++------ 2 files changed, 8 insertions(+), 10 deletions(-) diff --git a/contemplate.lsp b/contemplate.lsp index af1998fe..aa8979fe 100644 --- a/contemplate.lsp +++ b/contemplate.lsp @@ -27,9 +27,9 @@ (load "lisp-unit.lsp") (defpackage :lisp-koans - (:use :common-lisp) - (:use :lisp-unit) - #+sbcl (:use :sb-ext)) + (:use #:common-lisp + #:com.google.lisp-koans.test + #+sbcl #:sb-ext)) (in-package :lisp-koans) @@ -67,7 +67,9 @@ (in-package :lisp-koans) (unless (find-package koan-package-name) (make-package koan-package-name - :use '(:common-lisp :lisp-unit #+sbcl :sb-ext))) + :use '(#:common-lisp + #:com.google.lisp-koans.test + #+sbcl #:sb-ext))) (setf *package* (find-package koan-package-name)) (load (concatenate 'string *koan-dir-name* "/" koan-file-name)) (incf *n-total-koans* (length (list-tests))) diff --git a/lisp-unit.lsp b/lisp-unit.lsp index 95d5301b..11cee51c 100644 --- a/lisp-unit.lsp +++ b/lisp-unit.lsp @@ -77,9 +77,7 @@ functions or even macros does not require reloading any tests. |# ;;; Packages -(in-package :cl-user) - -(defpackage :lisp-unit +(defpackage #:com.google.lisp-koans.test (:use :common-lisp) ;; Print parameters (:export :*print-summary* @@ -128,7 +126,7 @@ functions or even macros does not require reloading any tests. ;; Utility predicates (:export :logically-equal :set-equal)) -(in-package :lisp-unit) +(in-package #:com.google.lisp-koans.test) ;; blank constants allow the incomplete tests to compile without errors @@ -747,5 +745,3 @@ assertion.") (listp l2) (subsetp l1 l2 :test test) (subsetp l2 l1 :test test))) - -(pushnew :lisp-unit common-lisp:*features*) From b643ee14e58849d6ff5cd041eee196690b61ee93 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 13:31:19 +0200 Subject: [PATCH 056/133] Refactor main code Create a MAIN function and execute it instead of having bare toplevel forms. --- contemplate.lsp | 42 +++++++++++++++++++++++++----------------- 1 file changed, 25 insertions(+), 17 deletions(-) diff --git a/contemplate.lsp b/contemplate.lsp index aa8979fe..6d0e2deb 100644 --- a/contemplate.lsp +++ b/contemplate.lsp @@ -196,26 +196,34 @@ ;; Load all the koans before testing any, and ;; count how many total koans there are. -(loop for koan-group-name in *all-koans-groups* - do - (load-koan-group-named koan-group-name)) +(defun load-all-koans () + (loop for koan-group-name in *all-koans-groups* + do (load-koan-group-named koan-group-name))) ;; Run through the koans until reaching the end condition. ;; Store the results in *collected-results* -(setf *collected-results* - (loop for koan-group-name in *all-koans-groups* - for kg-results = (run-koan-group-named koan-group-name) - collect (list koan-group-name kg-results) - do (if *print-koan-progress* - (print-koan-group-progress koan-group-name kg-results)) - ;; *proceed-after-failure* is defined in lisp-unit - until (and (not *proceed-after-failure*) (any-non-pass-p kg-results)))) +(defun execute-koans () + (setf *collected-results* + (loop for koan-group-name in *all-koans-groups* + for kg-results = (run-koan-group-named koan-group-name) + collect (list koan-group-name kg-results) + do (if *print-koan-progress* + (print-koan-group-progress koan-group-name kg-results)) + ;; *proceed-after-failure* is defined in lisp-unit + until (and (not *proceed-after-failure*) (any-non-pass-p kg-results))))) ;; Output advice to the learner -(if (any-assert-non-pass-p) - (progn - (print-next-suggestion-message) - (format t "~%") - (print-progress-message)) - (print-completion-message)) +(defun output-advice () + (cond ((any-assert-non-pass-p) + (print-next-suggestion-message) + (format t "~%") + (print-progress-message)) + (t (print-completion-message)))) + +(defun main () + (load-all-koans) + (execute-koans) + (output-advice)) + +(main) From 5f76a5b5060a0231caac2fbe82e20949e07088e3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 13:42:12 +0200 Subject: [PATCH 057/133] Adjust comment and newline style Comments have been adjusted to follow CLHS standards. All #||#-style comments have been replaced with semicolon ones. Superfluous newlines have been removed. --- contemplate.lsp | 63 +++++++++++------------- lisp-unit.lsp | 124 +++++++++++++++++------------------------------- 2 files changed, 73 insertions(+), 114 deletions(-) diff --git a/contemplate.lsp b/contemplate.lsp index 6d0e2deb..8f0463e8 100644 --- a/contemplate.lsp +++ b/contemplate.lsp @@ -1,29 +1,27 @@ -;; 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. - +;;; 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. (in-package :cl-user) -;; Though Clozure / CCL runs lisp-koans on the command line using -;; "ccl -l contemplate.lsp", the following lines are needed to -;; meditate on the koans within the CCL IDE. -;; (The :hemlock is used to distiguish between ccl commandline and the IDE) +;;; Though Clozure / CCL runs lisp-koans on the command line using +;;; "ccl -l contemplate.lsp", the following lines are needed to +;;; meditate on the koans within the CCL IDE. +;;; (The :hemlock is used to distiguish between ccl commandline and the IDE) #+(and :ccl :hemlock) (setf *default-pathname-defaults* (directory-namestring *load-pathname*)) - -;; lisp-unit defines the modules for loading / executing koans +;;; lisp-unit defines the modules for loading / executing koans (load "lisp-unit.lsp") (defpackage :lisp-koans @@ -33,21 +31,21 @@ (in-package :lisp-koans) -;; .koans file controls which files in *koan-dir-name* are loaded as -;; koans to complete +;;; .koans file controls which files in *koan-dir-name* are loaded as +;;; koans to complete (defvar *koan-dir-name* "koans") (with-open-file (in #P".koans") (with-standard-io-syntax (defvar *all-koans-groups* (read in)))) -;; set *print-koan-progress* to t to list all completed koans before summary +;;; set *print-koan-progress* to t to list all completed koans before summary (defvar *print-koan-progress* t) -;; debug-print directives +;;; debug-print directives (defvar *dp-loading* nil) - -;; Global state used to hold results of loading and processing koans +;;; Global state used to hold results of loading and processing koans (defvar *n-total-koans* 0) + (defvar *collected-results* nil) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -76,8 +74,6 @@ (in-package :lisp-koans) (if *dp-loading* (format t "done loading ~A ~%" koan-file-name)))) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for executing koans ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -189,19 +185,18 @@ (- (length *collected-results*) 1) (length *all-koans-groups*))) - ;;;;;;;;;; ;; Main ;; ;;;;;;;;;; -;; Load all the koans before testing any, and -;; count how many total koans there are. +;;; Load all the koans before testing any, and +;;; count how many total koans there are. (defun load-all-koans () (loop for koan-group-name in *all-koans-groups* do (load-koan-group-named koan-group-name))) -;; Run through the koans until reaching the end condition. -;; Store the results in *collected-results* +;;; Run through the koans until reaching the end condition. +;;; Store the results in *collected-results* (defun execute-koans () (setf *collected-results* (loop for koan-group-name in *all-koans-groups* @@ -213,7 +208,7 @@ until (and (not *proceed-after-failure*) (any-non-pass-p kg-results))))) -;; Output advice to the learner +;;; Output advice to the learner (defun output-advice () (cond ((any-assert-non-pass-p) (print-next-suggestion-message) diff --git a/lisp-unit.lsp b/lisp-unit.lsp index 11cee51c..74198f05 100644 --- a/lisp-unit.lsp +++ b/lisp-unit.lsp @@ -1,80 +1,47 @@ -;;;-*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*- - -#| -This version of lisp-unit.lsp has been extended to support the lisp koans. -Specifically, it is an unnamed branch from -https://github.com/OdonataResearchLLC/lisp-unit/ -with hash 93d07b2fa6e32364916225f6218e9e7313027c1f - -Modifications were made to: - 1) Support *incomplete* tests in addition to *passing* and *failing* ones - 2) End test execution at the first non-passing test. -|# - - -#| -Copyright (c) 2004-2005 Christopher K. Riesbeck - -Permission is hereby granted, free of charge, to any person obtaining -a copy of this software and associated documentation files (the "Software"), -to deal in the Software without restriction, including without limitation -the rights to use, copy, modify, merge, publish, distribute, sublicense, -and/or sell copies of the Software, and to permit persons to whom the -Software is furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included -in all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR -OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, -ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR -OTHER DEALINGS IN THE SOFTWARE. - - -How to use ----------- - -1. Read the documentation at: - https://github.com/OdonataResearchLLC/lisp-unit/wiki - -2. Make a file of DEFINE-TEST's. See exercise-tests.lisp for many -examples. If you want, start your test file with (REMOVE-TESTS :ALL) -to clear any previously defined tests. - -3. Load this file. - -4. (use-package :lisp-unit) - -5. Load your code file and your file of tests. - -6. Test your code with (RUN-TESTS '(test-name1 test-name2 ...)) or -simply (RUN-TESTS :ALL) to run all defined tests. - -A summary of how many tests passed and failed will be printed. - -NOTE: Nothing is compiled until RUN-TESTS is expanded. Redefining -functions or even macros does not require reloading any tests. - -|# - -#| - 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. -|# +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*- + +;;; Copyright (c) 2004-2005 Christopher K. Riesbeck +;;; +;;; Permission is hereby granted, free of charge, to any person obtaining +;;; a copy of this software and associated documentation files (the "Software"), +;;; to deal in the Software without restriction, including without limitation +;;; the rights to use, copy, modify, merge, publish, distribute, sublicense, +;;; and/or sell copies of the Software, and to permit persons to whom the +;;; Software is furnished to do so, subject to the following conditions: +;;; +;;; The above copyright notice and this permission notice shall be included +;;; in all copies or substantial portions of the Software. +;;; +;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +;;; OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +;;; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR +;;; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, +;;; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +;;; OTHER DEALINGS IN THE SOFTWARE. + +;;; 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. + +;;; This version of lisp-unit.lsp has been extended to support the lisp koans. +;;; Specifically, it is an unnamed branch from +;;; https://github.com/OdonataResearchLLC/lisp-unit/ +;;; with hash 93d07b2fa6e32364916225f6218e9e7313027c1f +;;; +;;; Modifications were made to: +;;; 1) Support *incomplete* tests in addition to *passing* and *failing* ones +;;; 2) End test execution at the first non-passing test. ;;; Packages (defpackage #:com.google.lisp-koans.test @@ -128,7 +95,6 @@ functions or even macros does not require reloading any tests. (in-package #:com.google.lisp-koans.test) - ;; blank constants allow the incomplete tests to compile without errors (defconstant __ :blank-value) (defconstant ___ :blank-value) @@ -136,7 +102,6 @@ functions or even macros does not require reloading any tests. (defvar +blanks+ '(__ ___ ____)) (defconstant +blank-value+ 'BLANK-VALUE) - ;;; Global counters (defparameter *pass* 0 @@ -744,4 +709,3 @@ assertion.") (and (listp l1) (listp l2) (subsetp l1 l2 :test test) - (subsetp l2 l1 :test test))) From f64c9ef68a28dca6c64b59ea7c1fdb6dc48e54d5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 13:44:11 +0200 Subject: [PATCH 058/133] Move comment to docstring in SET-EQUAL --- lisp-unit.lsp | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/lisp-unit.lsp b/lisp-unit.lsp index 74198f05..95c9925f 100644 --- a/lisp-unit.lsp +++ b/lisp-unit.lsp @@ -702,10 +702,8 @@ assertion.") "Run the tests associated with the specified tags in package." (%run-thunks (tagged-tests tags package) package)) -;;; (SET-EQUAL l1 l2 :test) => true or false -;;; Return true if every element of l1 is an element of l2 -;;; and vice versa. (defun set-equal (l1 l2 &key (test #'equal)) + "Return true if every element of l1 is an element of l2 and vice versa." (and (listp l1) (listp l2) - (subsetp l1 l2 :test test) + (subsetp l1 l2 :test test))) From 47dc695da24c6c1490c86d7427dd8729e39a13c6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 14:02:17 +0200 Subject: [PATCH 059/133] Separate lisp-koans from contemplate --- contemplate.lsp | 201 +-------------------------------------------- lisp-koans.lsp | 211 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 213 insertions(+), 199 deletions(-) create mode 100644 lisp-koans.lsp diff --git a/contemplate.lsp b/contemplate.lsp index 8f0463e8..fb20c4f5 100644 --- a/contemplate.lsp +++ b/contemplate.lsp @@ -21,204 +21,7 @@ #+(and :ccl :hemlock) (setf *default-pathname-defaults* (directory-namestring *load-pathname*)) -;;; lisp-unit defines the modules for loading / executing koans (load "lisp-unit.lsp") +(load "lisp-koans.lsp") -(defpackage :lisp-koans - (:use #:common-lisp - #:com.google.lisp-koans.test - #+sbcl #:sb-ext)) - -(in-package :lisp-koans) - -;;; .koans file controls which files in *koan-dir-name* are loaded as -;;; koans to complete -(defvar *koan-dir-name* "koans") -(with-open-file (in #P".koans") - (with-standard-io-syntax - (defvar *all-koans-groups* (read in)))) - -;;; set *print-koan-progress* to t to list all completed koans before summary -(defvar *print-koan-progress* t) -;;; debug-print directives -(defvar *dp-loading* nil) - -;;; Global state used to hold results of loading and processing koans -(defvar *n-total-koans* 0) - -(defvar *collected-results* nil) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Functions for loading koans ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun package-name-from-group-name (group-name) - (format nil "COM.GOOGLE.LISP-KOANS.KOANS.~:@(~A~)" group-name)) - -(defun load-koan-group-named (koan-group-name) - ;; Creates a package for the koan-group based on koan-group-name. - ;; Loads a lisp file at *koan-dir-name* / koan-group-name .lsp - ;; Adds all the koans from that file to the package. - (let* ((koan-file-name (concatenate 'string (string-downcase (string koan-group-name)) ".lsp")) - (koan-package-name (package-name-from-group-name koan-group-name))) - (if *dp-loading* (format t "start loading ~A ~%" koan-file-name)) - (in-package :lisp-koans) - (unless (find-package koan-package-name) - (make-package koan-package-name - :use '(#:common-lisp - #:com.google.lisp-koans.test - #+sbcl #:sb-ext))) - (setf *package* (find-package koan-package-name)) - (load (concatenate 'string *koan-dir-name* "/" koan-file-name)) - (incf *n-total-koans* (length (list-tests))) - (in-package :lisp-koans) - (if *dp-loading* (format t "done loading ~A ~%" koan-file-name)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Functions for executing koans ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun run-koan-group-named (koan-group-name) - ;; Executes the koan group, using run-koans defined in lisp-unit - ;; returning a test-results object. - (if *dp-loading* (format t "start running ~A ~%" koan-group-name)) - (run-koans (package-name-from-group-name koan-group-name))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Functions for printing progress ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun print-one-koan-status (k-result) - (let ((koan-name (first k-result)) - (all-pass-p (every - #'(lambda (x) (equalp :pass x)) - (second k-result)))) - (if all-pass-p - (format t "~A has expanded your awareness.~%" koan-name) - (format t "~A requires more meditation.~%" koan-name)))) - -(defun print-koan-group-progress (kg-name kg-results) - (format t "~%Thinking about ~A~%" kg-name) - (dolist (k-result (reverse kg-results)) - (format t " ") - (print-one-koan-status k-result)) - (format t "~%")) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Functions for processing results ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun any-assert-non-pass-p () - (dolist (k-group-result *collected-results*) - (dolist (koan-result (second k-group-result)) - (dolist (one-assert (second koan-result)) - (if (not (equal one-assert :pass)) - (return-from any-assert-non-pass-p one-assert))))) - nil) - -(defun get-error-filename (collected-results) - (first (first (last collected-results)))) - -(defun get-error-koan-name (collected-results) - (first (first (second (first (last (last collected-results))))))) - -(defun get-error-koan-status (collected-results) - (second (first (second (first (last (last collected-results))))))) - -(defun koan-status-message (koan-status) - (if (find :incomplete koan-status) - (return-from koan-status-message - " A koan is incomplete.~%")) - (if (find :fail koan-status) - (return-from koan-status-message - " A koan is incorrect.~%")) - (if (find :error koan-status) - (return-from koan-status-message - " A koan threw an error.~%")) - (format t " last koan status: ~A~%" koan-status) - "") - -(defun print-next-suggestion-message () - (let ((filename (get-error-filename *collected-results*)) - (koan-name (get-error-koan-name *collected-results*)) - (koan-status (get-error-koan-status *collected-results*))) - (format t "You have not yet reached enlightenment ...~%") - (format t (koan-status-message koan-status)) - (format t "~%") - (format t "Please meditate on the following code:~%") - (format t " File \"~A/~A.lsp\"~%" *koan-dir-name* (string-downcase filename)) - (format t " Koan \"~A\"~%" koan-name) - (format t " Current koan assert status is \"~A\"~%" (reverse koan-status)))) - -(defun print-completion-message () - (format t "**********************************************************~%") - (format t "That was the last one, well done! ENLIGHTENMENT IS YOURS!~%") - (format t "**********************************************************~%~%") - (format t "If you demand greater challenge, take a look at extra-credit.lsp~%") - (format t "Or, let the student become the teacher:~%") - (format t " Write and submit your own improvements to github.com/google/lisp-koans!~%")) - -(defun n-completed-koans (collected-results) - (loop for kg in collected-results - sum (length (second kg)) into partial-sum - finally (return partial-sum))) - -(defun all-asserts-passed-in-koan-p (koan-result) - (equal - (length (second koan-result)) - (count :pass (second koan-result)))) - -(defun n-passed-koans-in-group (kg) - (loop for k in (second kg) - counting (all-asserts-passed-in-koan-p k) into partial-sum - finally (return partial-sum))) - -(defun n-passed-koans-overall (collected-results) - (loop for kg in collected-results - sum (n-passed-koans-in-group kg) into partial-sum - finally (return partial-sum))) - -(defun print-progress-message () - (format t "You are now ~A/~A koans and ~A/~A lessons closer to reaching enlightenment~%~%" - (n-passed-koans-overall *collected-results*) - *n-total-koans* - (- (length *collected-results*) 1) - (length *all-koans-groups*))) - -;;;;;;;;;; -;; Main ;; -;;;;;;;;;; - -;;; Load all the koans before testing any, and -;;; count how many total koans there are. -(defun load-all-koans () - (loop for koan-group-name in *all-koans-groups* - do (load-koan-group-named koan-group-name))) - -;;; Run through the koans until reaching the end condition. -;;; Store the results in *collected-results* -(defun execute-koans () - (setf *collected-results* - (loop for koan-group-name in *all-koans-groups* - for kg-results = (run-koan-group-named koan-group-name) - collect (list koan-group-name kg-results) - do (if *print-koan-progress* - (print-koan-group-progress koan-group-name kg-results)) - ;; *proceed-after-failure* is defined in lisp-unit - until (and (not *proceed-after-failure*) (any-non-pass-p kg-results))))) - - -;;; Output advice to the learner -(defun output-advice () - (cond ((any-assert-non-pass-p) - (print-next-suggestion-message) - (format t "~%") - (print-progress-message)) - (t (print-completion-message)))) - -(defun main () - (load-all-koans) - (execute-koans) - (output-advice)) - -(main) +(lisp-koans:main) diff --git a/lisp-koans.lsp b/lisp-koans.lsp new file mode 100644 index 00000000..34941982 --- /dev/null +++ b/lisp-koans.lsp @@ -0,0 +1,211 @@ +;;; 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. + +(defpackage #:lisp-koans + (:use #:common-lisp + #:com.google.lisp-koans.test + #+sbcl #:sb-ext) + (:export #:main)) + +(in-package :lisp-koans) + +;;; .koans file controls which files in *koan-dir-name* are loaded as +;;; koans to complete +(defvar *koan-dir-name* "koans") +(with-open-file (in #P".koans") + (with-standard-io-syntax + (defvar *all-koans-groups* (read in)))) + +;;; set *print-koan-progress* to t to list all completed koans before summary +(defvar *print-koan-progress* t) +;;; debug-print directives +(defvar *dp-loading* nil) + +;;; Global state used to hold results of loading and processing koans +(defvar *n-total-koans* 0) + +(defvar *collected-results* nil) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions for loading koans ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun package-name-from-group-name (group-name) + (format nil "COM.GOOGLE.LISP-KOANS.KOANS.~:@(~A~)" group-name)) + +(defun load-koan-group-named (koan-group-name) + ;; Creates a package for the koan-group based on koan-group-name. + ;; Loads a lisp file at *koan-dir-name* / koan-group-name .lsp + ;; Adds all the koans from that file to the package. + (let* ((koan-file-name (concatenate 'string (string-downcase (string koan-group-name)) ".lsp")) + (koan-package-name (package-name-from-group-name koan-group-name))) + (if *dp-loading* (format t "start loading ~A ~%" koan-file-name)) + (in-package :lisp-koans) + (unless (find-package koan-package-name) + (make-package koan-package-name + :use '(#:common-lisp + #:com.google.lisp-koans.test + #+sbcl #:sb-ext))) + (setf *package* (find-package koan-package-name)) + (load (concatenate 'string *koan-dir-name* "/" koan-file-name)) + (incf *n-total-koans* (length (list-tests))) + (in-package :lisp-koans) + (if *dp-loading* (format t "done loading ~A ~%" koan-file-name)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions for executing koans ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun run-koan-group-named (koan-group-name) + ;; Executes the koan group, using run-koans defined in lisp-unit + ;; returning a test-results object. + (if *dp-loading* (format t "start running ~A ~%" koan-group-name)) + (run-koans (package-name-from-group-name koan-group-name))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions for printing progress ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun print-one-koan-status (k-result) + (let ((koan-name (first k-result)) + (all-pass-p (every + #'(lambda (x) (equalp :pass x)) + (second k-result)))) + (if all-pass-p + (format t "~A has expanded your awareness.~%" koan-name) + (format t "~A requires more meditation.~%" koan-name)))) + +(defun print-koan-group-progress (kg-name kg-results) + (format t "~%Thinking about ~A~%" kg-name) + (dolist (k-result (reverse kg-results)) + (format t " ") + (print-one-koan-status k-result)) + (format t "~%")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions for processing results ;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun any-assert-non-pass-p () + (dolist (k-group-result *collected-results*) + (dolist (koan-result (second k-group-result)) + (dolist (one-assert (second koan-result)) + (if (not (equal one-assert :pass)) + (return-from any-assert-non-pass-p one-assert))))) + nil) + +(defun get-error-filename (collected-results) + (first (first (last collected-results)))) + +(defun get-error-koan-name (collected-results) + (first (first (second (first (last (last collected-results))))))) + +(defun get-error-koan-status (collected-results) + (second (first (second (first (last (last collected-results))))))) + +(defun koan-status-message (koan-status) + (if (find :incomplete koan-status) + (return-from koan-status-message + " A koan is incomplete.~%")) + (if (find :fail koan-status) + (return-from koan-status-message + " A koan is incorrect.~%")) + (if (find :error koan-status) + (return-from koan-status-message + " A koan threw an error.~%")) + (format t " last koan status: ~A~%" koan-status) + "") + +(defun print-next-suggestion-message () + (let ((filename (get-error-filename *collected-results*)) + (koan-name (get-error-koan-name *collected-results*)) + (koan-status (get-error-koan-status *collected-results*))) + (format t "You have not yet reached enlightenment ...~%") + (format t (koan-status-message koan-status)) + (format t "~%") + (format t "Please meditate on the following code:~%") + (format t " File \"~A/~A.lsp\"~%" *koan-dir-name* (string-downcase filename)) + (format t " Koan \"~A\"~%" koan-name) + (format t " Current koan assert status is \"~A\"~%" (reverse koan-status)))) + +(defun print-completion-message () + (format t "**********************************************************~%") + (format t "That was the last one, well done! ENLIGHTENMENT IS YOURS!~%") + (format t "**********************************************************~%~%") + (format t "If you demand greater challenge, take a look at extra-credit.lsp~%") + (format t "Or, let the student become the teacher:~%") + (format t " Write and submit your own improvements to github.com/google/lisp-koans!~%")) + +(defun n-completed-koans (collected-results) + (loop for kg in collected-results + sum (length (second kg)) into partial-sum + finally (return partial-sum))) + +(defun all-asserts-passed-in-koan-p (koan-result) + (equal + (length (second koan-result)) + (count :pass (second koan-result)))) + +(defun n-passed-koans-in-group (kg) + (loop for k in (second kg) + counting (all-asserts-passed-in-koan-p k) into partial-sum + finally (return partial-sum))) + +(defun n-passed-koans-overall (collected-results) + (loop for kg in collected-results + sum (n-passed-koans-in-group kg) into partial-sum + finally (return partial-sum))) + +(defun print-progress-message () + (format t "You are now ~A/~A koans and ~A/~A lessons closer to reaching enlightenment~%~%" + (n-passed-koans-overall *collected-results*) + *n-total-koans* + (- (length *collected-results*) 1) + (length *all-koans-groups*))) + +;;;;;;;;;; +;; Main ;; +;;;;;;;;;; + +;;; Load all the koans before testing any, and +;;; count how many total koans there are. +(defun load-all-koans () + (loop for koan-group-name in *all-koans-groups* + do (load-koan-group-named koan-group-name))) + +;;; Run through the koans until reaching the end condition. +;;; Store the results in *collected-results* +(defun execute-koans () + (setf *collected-results* + (loop for koan-group-name in *all-koans-groups* + for kg-results = (run-koan-group-named koan-group-name) + collect (list koan-group-name kg-results) + do (if *print-koan-progress* + (print-koan-group-progress koan-group-name kg-results)) + ;; *proceed-after-failure* is defined in lisp-unit + until (and (not *proceed-after-failure*) (any-non-pass-p kg-results))))) + + +;;; Output advice to the learner +(defun output-advice () + (cond ((any-assert-non-pass-p) + (print-next-suggestion-message) + (format t "~%") + (print-progress-message)) + (t (print-completion-message)))) + +(defun main () + (load-all-koans) + (execute-koans) + (output-advice)) From d7593c89aa25cbe477df6163b06777f1ead56a97 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 14:04:52 +0200 Subject: [PATCH 060/133] Factor load-koan-group-named --- lisp-koans.lsp | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp-koans.lsp b/lisp-koans.lsp index 34941982..88bf3091 100644 --- a/lisp-koans.lsp +++ b/lisp-koans.lsp @@ -29,6 +29,7 @@ ;;; set *print-koan-progress* to t to list all completed koans before summary (defvar *print-koan-progress* t) + ;;; debug-print directives (defvar *dp-loading* nil) @@ -48,7 +49,8 @@ ;; Creates a package for the koan-group based on koan-group-name. ;; Loads a lisp file at *koan-dir-name* / koan-group-name .lsp ;; Adds all the koans from that file to the package. - (let* ((koan-file-name (concatenate 'string (string-downcase (string koan-group-name)) ".lsp")) + (let* ((koan-name (string-downcase (string koan-group-name))) + (koan-file-name (concatenate 'string koan-name ".lsp")) (koan-package-name (package-name-from-group-name koan-group-name))) (if *dp-loading* (format t "start loading ~A ~%" koan-file-name)) (in-package :lisp-koans) From b590d71adc0bf7d34f427cf4eed39863a35deaa0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 14:07:06 +0200 Subject: [PATCH 061/133] Reindent lisp-koans --- lisp-koans.lsp | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/lisp-koans.lsp b/lisp-koans.lsp index 88bf3091..a65c9eb1 100644 --- a/lisp-koans.lsp +++ b/lisp-koans.lsp @@ -100,12 +100,12 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun any-assert-non-pass-p () - (dolist (k-group-result *collected-results*) - (dolist (koan-result (second k-group-result)) - (dolist (one-assert (second koan-result)) - (if (not (equal one-assert :pass)) - (return-from any-assert-non-pass-p one-assert))))) - nil) + (dolist (k-group-result *collected-results*) + (dolist (koan-result (second k-group-result)) + (dolist (one-assert (second koan-result)) + (if (not (equal one-assert :pass)) + (return-from any-assert-non-pass-p one-assert))))) + nil) (defun get-error-filename (collected-results) (first (first (last collected-results)))) @@ -118,14 +118,14 @@ (defun koan-status-message (koan-status) (if (find :incomplete koan-status) - (return-from koan-status-message - " A koan is incomplete.~%")) + (return-from koan-status-message + " A koan is incomplete.~%")) (if (find :fail koan-status) - (return-from koan-status-message - " A koan is incorrect.~%")) + (return-from koan-status-message + " A koan is incorrect.~%")) (if (find :error koan-status) - (return-from koan-status-message - " A koan threw an error.~%")) + (return-from koan-status-message + " A koan threw an error.~%")) (format t " last koan status: ~A~%" koan-status) "") @@ -170,11 +170,11 @@ finally (return partial-sum))) (defun print-progress-message () - (format t "You are now ~A/~A koans and ~A/~A lessons closer to reaching enlightenment~%~%" - (n-passed-koans-overall *collected-results*) - *n-total-koans* - (- (length *collected-results*) 1) - (length *all-koans-groups*))) + (format t "You are now ~A/~A koans and ~A/~A lessons closer to reaching enlightenment~%~%" + (n-passed-koans-overall *collected-results*) + *n-total-koans* + (- (length *collected-results*) 1) + (length *all-koans-groups*))) ;;;;;;;;;; ;; Main ;; From 4acfe81e8d3d3fc52e94e91e977f489111c6967e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 14:18:59 +0200 Subject: [PATCH 062/133] Refactor *ALL-KOANS-GROUPS* --- lisp-koans.lsp | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp-koans.lsp b/lisp-koans.lsp index a65c9eb1..0075e845 100644 --- a/lisp-koans.lsp +++ b/lisp-koans.lsp @@ -23,9 +23,11 @@ ;;; .koans file controls which files in *koan-dir-name* are loaded as ;;; koans to complete (defvar *koan-dir-name* "koans") -(with-open-file (in #P".koans") - (with-standard-io-syntax - (defvar *all-koans-groups* (read in)))) + +(defvar *all-koans-groups* + (with-open-file (in #P".koans") + (with-standard-io-syntax + (read in)))) ;;; set *print-koan-progress* to t to list all completed koans before summary (defvar *print-koan-progress* t) From bf5246d3402e176d0d4003bb3ab346f6b36b7b1a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 14:19:20 +0200 Subject: [PATCH 063/133] Add emacs modeline --- lisp-unit.lsp | 2 -- 1 file changed, 2 deletions(-) diff --git a/lisp-unit.lsp b/lisp-unit.lsp index 95c9925f..84a68f9e 100644 --- a/lisp-unit.lsp +++ b/lisp-unit.lsp @@ -1,5 +1,3 @@ -;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*- - ;;; Copyright (c) 2004-2005 Christopher K. Riesbeck ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining From 681f39cf9d95091e40df1d3b53e23c7b2460fdb0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 14:30:27 +0200 Subject: [PATCH 064/133] Reactor LOAD-KOAN-GROUP-NAMED --- lisp-koans.lsp | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/lisp-koans.lsp b/lisp-koans.lsp index 0075e845..23cd2cf4 100644 --- a/lisp-koans.lsp +++ b/lisp-koans.lsp @@ -26,8 +26,7 @@ (defvar *all-koans-groups* (with-open-file (in #P".koans") - (with-standard-io-syntax - (read in)))) + (with-standard-io-syntax (read in)))) ;;; set *print-koan-progress* to t to list all completed koans before summary (defvar *print-koan-progress* t) @@ -55,16 +54,14 @@ (koan-file-name (concatenate 'string koan-name ".lsp")) (koan-package-name (package-name-from-group-name koan-group-name))) (if *dp-loading* (format t "start loading ~A ~%" koan-file-name)) - (in-package :lisp-koans) (unless (find-package koan-package-name) (make-package koan-package-name :use '(#:common-lisp #:com.google.lisp-koans.test #+sbcl #:sb-ext))) - (setf *package* (find-package koan-package-name)) - (load (concatenate 'string *koan-dir-name* "/" koan-file-name)) - (incf *n-total-koans* (length (list-tests))) - (in-package :lisp-koans) + (let ((*package* (find-package koan-package-name))) + (load (concatenate 'string *koan-dir-name* "/" koan-file-name)) + (incf *n-total-koans* (length (list-tests)))) (if *dp-loading* (format t "done loading ~A ~%" koan-file-name)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; From 64ebed1271eda5bf3805949e1d54ca4e42ed5270 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 14:30:37 +0200 Subject: [PATCH 065/133] Remove tags from lisp-unit The tag-functionality was present, but completely unused. For code clarity, it is now removed. --- lisp-unit.lsp | 94 ++++----------------------------------------------- 1 file changed, 6 insertions(+), 88 deletions(-) diff --git a/lisp-unit.lsp b/lisp-unit.lsp index 84a68f9e..0640b9d7 100644 --- a/lisp-unit.lsp +++ b/lisp-unit.lsp @@ -70,11 +70,6 @@ :run-tests :run-koans :use-debugger) - ;; Functions for managing tags - (:export :list-tags - :tagged-tests - :remove-tags - :run-tags) ;; Constants for blanks in koans (:export __ ___ @@ -207,19 +202,6 @@ assertion.") (setf (gethash package *test-db*) (make-hash-table))) (t (warn "No tests defined for package: ~S" package)))) -;;; Global tags database - -(defparameter *tag-db* (make-hash-table :test #'eq) - "The tag database is simply a hash table.") - -(defun package-tags (package &optional create) - "Return the tags DB for the package." - (cond - ((gethash (find-package package) *tag-db*)) - (create - (setf (gethash package *tag-db*) (make-hash-table))) - (t (warn "No tags defined for package: ~S" package)))) - (defclass unit-test () ((doc :type string @@ -234,30 +216,21 @@ assertion.") "Organize the unit test documentation and code.")) ;;; NOTE: Shamelessly taken from PG's analyze-body -(defun parse-body (body &optional doc tag) +(defun parse-body (body &optional doc) "Separate the components of the body." (let ((item (first body))) - (cond - ((and (listp item) (eq :tag (first item))) - (parse-body (rest body) doc (nconc (rest item) tag))) - ((and (stringp item) (not doc) (rest body)) - (if tag - (values doc tag (rest body)) - (parse-body (rest body) doc tag))) - (t (values doc tag body))))) + (if (and (stringp item) (not doc) (rest body)) + (parse-body (rest body) doc) + (values doc body)))) (defmacro define-test (name &body body) "Store the test in the test database." - (multiple-value-bind (doc tag code) (parse-body body) + (multiple-value-bind (doc code) (parse-body body) `(let ((doc (or ,doc (string ',name)))) (setf ;; Unit test (gethash ',name (package-table *package* t)) (make-instance 'unit-test :doc doc :code ',code)) - ;; Tags - (loop for tag in ',tag do - (pushnew - ',name (gethash tag (package-tags *package* t)))) ;; Return the name of the test ',name))) @@ -291,64 +264,13 @@ assertion.") (if (eq :all names) (if (null package) (clrhash *test-db*) - (progn - (remhash (find-package package) *test-db*) - (remhash (find-package package) *tag-db*))) + (remhash (find-package package) *test-db*)) (let ((table (package-table package))) (unless (null table) ;; Remove tests (loop for name in names always (remhash name table) collect name into removed - finally (return removed)) - ;; Remove tests from tags - (loop with tags = (package-tags package) - for tag being each hash-key in tags - using (hash-value tagged-tests) - do - (setf - (gethash tag tags) - (set-difference tagged-tests names))))))) - -;;; Manage tags - -(defun %tests-from-all-tags (&optional (package *package*)) - "Return all of the tests that have been tagged." - (loop for tests being each hash-value in (package-tags package) - nconc (copy-list tests) into all-tests - finally (return (delete-duplicates all-tests)))) - -(defun %tests-from-tags (tags &optional (package *package*)) - "Return the tests associated with the tags." - (loop with table = (package-tags package) - for tag in tags - as tests = (gethash tag table) - nconc (copy-list tests) into all-tests - finally (return (delete-duplicates all-tests)))) - -(defun list-tags (&optional (package *package*)) - "Return a list of the tags in package." - (let ((tags (package-tags package))) - (when tags - (loop for tag being each hash-key in tags collect tag)))) - -(defun tagged-tests (tags &optional (package *package*)) - "Run the tests associated with the specified tags in package." - (if (eq :all tags) - (%tests-from-all-tags package) - (%tests-from-tags tags package))) - -(defun remove-tags (tags &optional (package *package*)) - "Remove individual tags or entire sets." - (if (eq :all tags) - (if (null package) - (clrhash *tag-db*) - (remhash (find-package package) *tag-db*)) - (let ((table (package-tags package))) - (unless (null table) - (loop for tag in tags - always (remhash tag table) - collect tag into removed finally (return removed)))))) ;;; Assert macros @@ -696,10 +618,6 @@ assertion.") (%run-all-thunks package) (%run-thunks test-names package))) -(defun run-tags (tags &optional (package *package*)) - "Run the tests associated with the specified tags in package." - (%run-thunks (tagged-tests tags package) package)) - (defun set-equal (l1 l2 &key (test #'equal)) "Return true if every element of l1 is an element of l2 and vice versa." (and (listp l1) From 48ea3a910c3da1c8af21f47992797cd9630b0c0b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 15:06:16 +0200 Subject: [PATCH 066/133] Remove debug printing It should be possible to infer load-time errors with backtraces alone. --- lisp-koans.lsp | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/lisp-koans.lsp b/lisp-koans.lsp index 23cd2cf4..4d2f1e13 100644 --- a/lisp-koans.lsp +++ b/lisp-koans.lsp @@ -31,9 +31,6 @@ ;;; set *print-koan-progress* to t to list all completed koans before summary (defvar *print-koan-progress* t) -;;; debug-print directives -(defvar *dp-loading* nil) - ;;; Global state used to hold results of loading and processing koans (defvar *n-total-koans* 0) @@ -53,7 +50,6 @@ (let* ((koan-name (string-downcase (string koan-group-name))) (koan-file-name (concatenate 'string koan-name ".lsp")) (koan-package-name (package-name-from-group-name koan-group-name))) - (if *dp-loading* (format t "start loading ~A ~%" koan-file-name)) (unless (find-package koan-package-name) (make-package koan-package-name :use '(#:common-lisp @@ -61,8 +57,7 @@ #+sbcl #:sb-ext))) (let ((*package* (find-package koan-package-name))) (load (concatenate 'string *koan-dir-name* "/" koan-file-name)) - (incf *n-total-koans* (length (list-tests)))) - (if *dp-loading* (format t "done loading ~A ~%" koan-file-name)))) + (incf *n-total-koans* (length (list-tests)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for executing koans ;; @@ -71,7 +66,6 @@ (defun run-koan-group-named (koan-group-name) ;; Executes the koan group, using run-koans defined in lisp-unit ;; returning a test-results object. - (if *dp-loading* (format t "start running ~A ~%" koan-group-name)) (run-koans (package-name-from-group-name koan-group-name))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; From 8b5b32011dd232be3096bdec4ca3d70ac35dd581 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 15:14:45 +0200 Subject: [PATCH 067/133] Replace LIST-TESTS with TEST-COUNT --- lisp-koans.lsp | 2 +- lisp-unit.lsp | 12 ++++++------ 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/lisp-koans.lsp b/lisp-koans.lsp index 4d2f1e13..50413103 100644 --- a/lisp-koans.lsp +++ b/lisp-koans.lsp @@ -57,7 +57,7 @@ #+sbcl #:sb-ext))) (let ((*package* (find-package koan-package-name))) (load (concatenate 'string *koan-dir-name* "/" koan-file-name)) - (incf *n-total-koans* (length (list-tests)))))) + (incf *n-total-koans* (test-count))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions for executing koans ;; diff --git a/lisp-unit.lsp b/lisp-unit.lsp index 0640b9d7..7e9f4327 100644 --- a/lisp-unit.lsp +++ b/lisp-unit.lsp @@ -63,7 +63,7 @@ :assert-error) ;; Functions for managing tests (:export :define-test - :list-tests + :test-count :test-code :test-documentation :remove-tests @@ -236,12 +236,12 @@ assertion.") ;;; Manage tests -(defun list-tests (&optional (package *package*)) - "Return a list of the tests in package." +(defun test-count (&optional (package *package*)) + "Returns the number of tests for a package." (let ((table (package-table package))) - (when table - (loop for test-name being each hash-key in table - collect test-name)))) + (if table + (hash-table-count table) + 0))) (defun test-documentation (name &optional (package *package*)) "Return the documentation for the test." From 44731c5a5aa1d8dd6a73d7a17246b7cc74382a2b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 15:15:05 +0200 Subject: [PATCH 068/133] Remove unnecessary upcase --- lisp-koans.lsp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp-koans.lsp b/lisp-koans.lsp index 50413103..6cac15ff 100644 --- a/lisp-koans.lsp +++ b/lisp-koans.lsp @@ -41,7 +41,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun package-name-from-group-name (group-name) - (format nil "COM.GOOGLE.LISP-KOANS.KOANS.~:@(~A~)" group-name)) + (format nil "COM.GOOGLE.LISP-KOANS.KOANS.~A" group-name)) (defun load-koan-group-named (koan-group-name) ;; Creates a package for the koan-group based on koan-group-name. From 9620306262c63ca169ba30a285d21ff768fa4a31 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 15:15:14 +0200 Subject: [PATCH 069/133] Clean up DEFINE-TEST --- lisp-unit.lsp | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/lisp-unit.lsp b/lisp-unit.lsp index 7e9f4327..2e7fb68a 100644 --- a/lisp-unit.lsp +++ b/lisp-unit.lsp @@ -227,11 +227,8 @@ assertion.") "Store the test in the test database." (multiple-value-bind (doc code) (parse-body body) `(let ((doc (or ,doc (string ',name)))) - (setf - ;; Unit test - (gethash ',name (package-table *package* t)) - (make-instance 'unit-test :doc doc :code ',code)) - ;; Return the name of the test + (setf (gethash ',name (package-table *package* t)) + (make-instance 'unit-test :doc doc :code ',code)) ',name))) ;;; Manage tests From 22c980011ec0081bffd33eb55145d3a8dbae585e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 15:16:05 +0200 Subject: [PATCH 070/133] Remove unused DEFCONSTANT +BLANK-VALUE+ --- .#lisp-unit.lsp | 1 + 1 file changed, 1 insertion(+) create mode 120000 .#lisp-unit.lsp diff --git a/.#lisp-unit.lsp b/.#lisp-unit.lsp new file mode 120000 index 00000000..8e5e85e2 --- /dev/null +++ b/.#lisp-unit.lsp @@ -0,0 +1 @@ +phoe@phoetower.5894:1588271947 \ No newline at end of file From 839f8711065f7521f0c61418e537481e4dffc69a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 15:18:35 +0200 Subject: [PATCH 071/133] Remove unused function SET-EQUAL --- .#lisp-unit.lsp | 1 - lisp-unit.lsp | 9 +-------- 2 files changed, 1 insertion(+), 9 deletions(-) delete mode 120000 .#lisp-unit.lsp diff --git a/.#lisp-unit.lsp b/.#lisp-unit.lsp deleted file mode 120000 index 8e5e85e2..00000000 --- a/.#lisp-unit.lsp +++ /dev/null @@ -1 +0,0 @@ -phoe@phoetower.5894:1588271947 \ No newline at end of file diff --git a/lisp-unit.lsp b/lisp-unit.lsp index 2e7fb68a..2ce83a08 100644 --- a/lisp-unit.lsp +++ b/lisp-unit.lsp @@ -84,7 +84,7 @@ :summarize-results :any-non-pass-p) ;; Utility predicates - (:export :logically-equal :set-equal)) + (:export :logically-equal)) (in-package #:com.google.lisp-koans.test) @@ -93,7 +93,6 @@ (defconstant ___ :blank-value) (defconstant ____ :blank-value) (defvar +blanks+ '(__ ___ ____)) -(defconstant +blank-value+ 'BLANK-VALUE) ;;; Global counters @@ -614,9 +613,3 @@ assertion.") (if (eq :all test-names) (%run-all-thunks package) (%run-thunks test-names package))) - -(defun set-equal (l1 l2 &key (test #'equal)) - "Return true if every element of l1 is an element of l2 and vice versa." - (and (listp l1) - (listp l2) - (subsetp l1 l2 :test test))) From c69a888e62ffa7e4a18248d8708c10a00c877d0a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 19:49:32 +0200 Subject: [PATCH 072/133] Remove dead code and overhaul the framework --- TODO | 5 +- contemplate.lsp | 4 +- lisp-koans.lsp | 222 ++++++---------- lisp-unit.lsp | 615 --------------------------------------------- test-framework.lsp | 175 +++++++++++++ 5 files changed, 253 insertions(+), 768 deletions(-) delete mode 100644 lisp-unit.lsp create mode 100644 test-framework.lsp diff --git a/TODO b/TODO index 8731fbc0..88cddc7e 100644 --- a/TODO +++ b/TODO @@ -1,4 +1 @@ -* make get-error-filename more maintainable -* make get-error-koan-name more maintainable -* make get-error-koan-status more maintainable -* improve error reporting from "a koan threw an error" to something more helpful +* improve error reporting from "a koan signaled an error" to something more helpful diff --git a/contemplate.lsp b/contemplate.lsp index fb20c4f5..d252dfd9 100644 --- a/contemplate.lsp +++ b/contemplate.lsp @@ -21,7 +21,7 @@ #+(and :ccl :hemlock) (setf *default-pathname-defaults* (directory-namestring *load-pathname*)) -(load "lisp-unit.lsp") +(load "test-framework.lsp") (load "lisp-koans.lsp") -(lisp-koans:main) +(com.google.lisp-koans:main) diff --git a/lisp-koans.lsp b/lisp-koans.lsp index 6cac15ff..b7479d7c 100644 --- a/lisp-koans.lsp +++ b/lisp-koans.lsp @@ -12,194 +12,122 @@ ;;; See the License for the specific language governing permissions and ;;; limitations under the License. -(defpackage #:lisp-koans +(defpackage #:com.google.lisp-koans (:use #:common-lisp - #:com.google.lisp-koans.test - #+sbcl #:sb-ext) + #:com.google.lisp-koans.test) (:export #:main)) -(in-package :lisp-koans) +(in-package :com.google.lisp-koans) -;;; .koans file controls which files in *koan-dir-name* are loaded as -;;; koans to complete (defvar *koan-dir-name* "koans") -(defvar *all-koans-groups* - (with-open-file (in #P".koans") +(defvar *all-koan-groups* + (with-open-file (in #p".koans") (with-standard-io-syntax (read in)))) -;;; set *print-koan-progress* to t to list all completed koans before summary -(defvar *print-koan-progress* t) - -;;; Global state used to hold results of loading and processing koans -(defvar *n-total-koans* 0) - (defvar *collected-results* nil) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Functions for loading koans ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Functions for loading koans (defun package-name-from-group-name (group-name) (format nil "COM.GOOGLE.LISP-KOANS.KOANS.~A" group-name)) (defun load-koan-group-named (koan-group-name) - ;; Creates a package for the koan-group based on koan-group-name. - ;; Loads a lisp file at *koan-dir-name* / koan-group-name .lsp - ;; Adds all the koans from that file to the package. (let* ((koan-name (string-downcase (string koan-group-name))) (koan-file-name (concatenate 'string koan-name ".lsp")) (koan-package-name (package-name-from-group-name koan-group-name))) (unless (find-package koan-package-name) (make-package koan-package-name - :use '(#:common-lisp - #:com.google.lisp-koans.test - #+sbcl #:sb-ext))) + :use '(#:common-lisp #:com.google.lisp-koans.test))) (let ((*package* (find-package koan-package-name))) - (load (concatenate 'string *koan-dir-name* "/" koan-file-name)) - (incf *n-total-koans* (test-count))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Functions for executing koans ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun run-koan-group-named (koan-group-name) - ;; Executes the koan group, using run-koans defined in lisp-unit - ;; returning a test-results object. - (run-koans (package-name-from-group-name koan-group-name))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Functions for printing progress ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun print-one-koan-status (k-result) - (let ((koan-name (first k-result)) - (all-pass-p (every - #'(lambda (x) (equalp :pass x)) - (second k-result)))) - (if all-pass-p - (format t "~A has expanded your awareness.~%" koan-name) - (format t "~A requires more meditation.~%" koan-name)))) - -(defun print-koan-group-progress (kg-name kg-results) - (format t "~%Thinking about ~A~%" kg-name) - (dolist (k-result (reverse kg-results)) - (format t " ") - (print-one-koan-status k-result)) - (format t "~%")) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Functions for processing results ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (load (concatenate 'string *koan-dir-name* "/" koan-file-name))))) -(defun any-assert-non-pass-p () - (dolist (k-group-result *collected-results*) - (dolist (koan-result (second k-group-result)) - (dolist (one-assert (second koan-result)) - (if (not (equal one-assert :pass)) - (return-from any-assert-non-pass-p one-assert))))) - nil) +(defun load-all-koans () + (loop for koan-group-name in *all-koan-groups* + do (load-koan-group-named koan-group-name))) -(defun get-error-filename (collected-results) - (first (first (last collected-results)))) +;;; Functions for executing koans -(defun get-error-koan-name (collected-results) - (first (first (second (first (last (last collected-results))))))) +(defun execute-koans () + (loop for koan-group-name in *all-koan-groups* + for package-name = (package-name-from-group-name koan-group-name) + for kg-results = (run-koans package-name) + collect (list koan-group-name kg-results) into results + do (print-koan-group-progress koan-group-name kg-results) + while (every (lambda (x) (eq x :pass)) (second (first kg-results))) + finally (setf *collected-results* results))) + +;;; Functions for printing progress + +(defun print-koan-group-progress (name results) + (format t "~%Thinking about ~A~%" name) + (dolist (result (reverse results)) + (destructuring-bind (test-name results) result + (let ((format-control (if (every (lambda (x) (equalp :pass x)) results) + " ~A has expanded your awareness.~%~%" + " ~A requires more meditation.~%~%"))) + (format t format-control test-name))))) + +;;; Functions for processing results + +(defun n-passed-koans-overall (collected-results) + (flet ((all-asserts-passed-in-koan-p (result) + (every (lambda (x) (eq :pass x)) (second result)))) + (loop for kg in collected-results + sum (count-if #'all-asserts-passed-in-koan-p (second kg))))) -(defun get-error-koan-status (collected-results) - (second (first (second (first (last (last collected-results))))))) +(defun any-assert-non-pass-p () + (dolist (k-group-result *collected-results*) + (dolist (result (second k-group-result)) + (dolist (one-assert (second result)) + (when (not (equal one-assert :pass)) + (return-from any-assert-non-pass-p one-assert)))))) + +;;; Functions for printing results (defun koan-status-message (koan-status) - (if (find :incomplete koan-status) - (return-from koan-status-message - " A koan is incomplete.~%")) - (if (find :fail koan-status) - (return-from koan-status-message - " A koan is incorrect.~%")) - (if (find :error koan-status) - (return-from koan-status-message - " A koan threw an error.~%")) - (format t " last koan status: ~A~%" koan-status) - "") + (cond ((find :incomplete koan-status) "A koan is incomplete.") + ((find :fail koan-status) "A koan is incorrect.") + ((find :error koan-status) "A koan signaled an error.") + (t (format nil "Last koan status: ~A." koan-status)))) (defun print-next-suggestion-message () - (let ((filename (get-error-filename *collected-results*)) - (koan-name (get-error-koan-name *collected-results*)) - (koan-status (get-error-koan-status *collected-results*))) - (format t "You have not yet reached enlightenment ...~%") - (format t (koan-status-message koan-status)) - (format t "~%") - (format t "Please meditate on the following code:~%") - (format t " File \"~A/~A.lsp\"~%" *koan-dir-name* (string-downcase filename)) - (format t " Koan \"~A\"~%" koan-name) - (format t " Current koan assert status is \"~A\"~%" (reverse koan-status)))) + (let ((filename (caar *collected-results*)) + (koan-name (caaadr (car (last (last *collected-results*))))) + (koan-status (reverse (cadaar (cdar (last (last *collected-results*))))))) + (format t "You have not yet reached enlightenment. + ~A +Please meditate on the following code: + File \"koans/~(~A~).lsp\" + Koan \"~A\" + Current koan assert status is \"~A\"~%~%" + (koan-status-message koan-status) filename koan-name koan-status))) (defun print-completion-message () - (format t "**********************************************************~%") - (format t "That was the last one, well done! ENLIGHTENMENT IS YOURS!~%") - (format t "**********************************************************~%~%") - (format t "If you demand greater challenge, take a look at extra-credit.lsp~%") - (format t "Or, let the student become the teacher:~%") - (format t " Write and submit your own improvements to github.com/google/lisp-koans!~%")) - -(defun n-completed-koans (collected-results) - (loop for kg in collected-results - sum (length (second kg)) into partial-sum - finally (return partial-sum))) - -(defun all-asserts-passed-in-koan-p (koan-result) - (equal - (length (second koan-result)) - (count :pass (second koan-result)))) - -(defun n-passed-koans-in-group (kg) - (loop for k in (second kg) - counting (all-asserts-passed-in-koan-p k) into partial-sum - finally (return partial-sum))) + (format t "********************************************************* +That was the last one, well done! ENLIGHTENMENT IS YOURS! +********************************************************* -(defun n-passed-koans-overall (collected-results) - (loop for kg in collected-results - sum (n-passed-koans-in-group kg) into partial-sum - finally (return partial-sum))) +If you demand greater challenge, take a look at extra-credit.lsp +Or, let the student become the teacher: +Write and submit your own improvements to https://github.com/google/lisp-koans! +")) (defun print-progress-message () (format t "You are now ~A/~A koans and ~A/~A lessons closer to reaching enlightenment~%~%" (n-passed-koans-overall *collected-results*) - *n-total-koans* - (- (length *collected-results*) 1) - (length *all-koans-groups*))) - -;;;;;;;;;; -;; Main ;; -;;;;;;;;;; - -;;; Load all the koans before testing any, and -;;; count how many total koans there are. -(defun load-all-koans () - (loop for koan-group-name in *all-koans-groups* - do (load-koan-group-named koan-group-name))) - -;;; Run through the koans until reaching the end condition. -;;; Store the results in *collected-results* -(defun execute-koans () - (setf *collected-results* - (loop for koan-group-name in *all-koans-groups* - for kg-results = (run-koan-group-named koan-group-name) - collect (list koan-group-name kg-results) - do (if *print-koan-progress* - (print-koan-group-progress koan-group-name kg-results)) - ;; *proceed-after-failure* is defined in lisp-unit - until (and (not *proceed-after-failure*) (any-non-pass-p kg-results))))) + (test-total-count) + (1- (length *collected-results*)) + (length *all-koan-groups*))) - -;;; Output advice to the learner (defun output-advice () (cond ((any-assert-non-pass-p) - (print-next-suggestion-message) - (format t "~%") - (print-progress-message)) + (print-progress-message) + (print-next-suggestion-message)) (t (print-completion-message)))) +;;; Main + (defun main () (load-all-koans) (execute-koans) diff --git a/lisp-unit.lsp b/lisp-unit.lsp deleted file mode 100644 index 2ce83a08..00000000 --- a/lisp-unit.lsp +++ /dev/null @@ -1,615 +0,0 @@ -;;; Copyright (c) 2004-2005 Christopher K. Riesbeck -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining -;;; a copy of this software and associated documentation files (the "Software"), -;;; to deal in the Software without restriction, including without limitation -;;; the rights to use, copy, modify, merge, publish, distribute, sublicense, -;;; and/or sell copies of the Software, and to permit persons to whom the -;;; Software is furnished to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included -;;; in all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -;;; OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -;;; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR -;;; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, -;;; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR -;;; OTHER DEALINGS IN THE SOFTWARE. - -;;; 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. - -;;; This version of lisp-unit.lsp has been extended to support the lisp koans. -;;; Specifically, it is an unnamed branch from -;;; https://github.com/OdonataResearchLLC/lisp-unit/ -;;; with hash 93d07b2fa6e32364916225f6218e9e7313027c1f -;;; -;;; Modifications were made to: -;;; 1) Support *incomplete* tests in addition to *passing* and *failing* ones -;;; 2) End test execution at the first non-passing test. - -;;; Packages -(defpackage #:com.google.lisp-koans.test - (:use :common-lisp) - ;; Print parameters - (:export :*print-summary* - :*print-failures* - :*print-errors* - :*proceed-after-failure*) - ;; Forms for assertions - (:export :assert-eq - :assert-eql - :assert-equal - :true-or-false? - :assert-equalp - :assert-equality - :assert-prints - :assert-expands - :assert-true - :assert-false - :assert-error) - ;; Functions for managing tests - (:export :define-test - :test-count - :test-code - :test-documentation - :remove-tests - :run-tests - :run-koans - :use-debugger) - ;; Constants for blanks in koans - (:export __ - ___ - ____ - +blanks+) - ;; Functions for reporting test results - (:export :test-names - :failed-tests - :incomplete-tests - :error-tests - :missing-tests - :summarize-results - :any-non-pass-p) - ;; Utility predicates - (:export :logically-equal)) - -(in-package #:com.google.lisp-koans.test) - -;; blank constants allow the incomplete tests to compile without errors -(defconstant __ :blank-value) -(defconstant ___ :blank-value) -(defconstant ____ :blank-value) -(defvar +blanks+ '(__ ___ ____)) - -;;; Global counters - -(defparameter *pass* 0 - "The number of passed assertions.") - -(defparameter *fail* 0 - "The number of failed assertions.") - -(defparameter *incomplete* 0 - "The number of incomplete assertions.") - -(defparameter *koan-assert-list* nil - "The record of a single koan.") - -;;; Global options - -(defparameter *proceed-after-failure* nil - "set to nil for normal operation. t will eval every koan") - -(defparameter *print-summary* nil - "Print a summary of the pass, fail, and error count if non-nil.") - -(defparameter *print-failures* nil - "Print failure messages if non-NIL.") - -(defparameter *print-errors* nil - "Print error messages if non-NIL.") - -(defparameter *use-debugger* nil - "If not NIL, enter the debugger when an error is encountered in an -assertion.") - -(defun use-debugger-p (condition) - "Debug or ignore errors." - (cond - ((eq :ask *use-debugger*) - (y-or-n-p "~A -- debug?" condition)) - (*use-debugger*))) - -(defun use-debugger (&optional (flag t)) - "Use the debugger when testing, or not." - (setq *use-debugger* flag)) - -;;; Failure control strings - -(defgeneric print-failure (type form expected actual extras) - (:documentation - "Report the details of the failure assertion.")) - -(defmethod print-failure :around (type form expected actual extras) - "Failure header and footer output." - (declare (ignore expected actual)) - (format t "~& | Failed Form: ~S" form) - (call-next-method) - (when extras - (format t "~{~& | ~S => ~S~}~%" (funcall extras))) - (format t "~& |~%") - type) - -(defmethod print-failure (type form expected actual extras) - (declare (ignore type form extras)) - (format t "~& | Expected ~{~S~^; ~} " expected) - (format t "~<~% | ~:;but saw ~{~S~^; ~}~>" actual)) - -(defmethod print-failure ((type (eql :error)) - form expected actual extras) - (declare (ignore form extras)) - (format t "~& | ~@[Should have signalled ~{~S~^; ~} but saw~]" - expected) - (format t " ~{~S~^; ~}" actual)) - -(defmethod print-failure ((type (eql :macro)) - form expected actual extras) - (declare (ignore form extras)) - (format t "~& | Should have expanded to ~{~S~^; ~} " expected) - (format t "~<~%~:;but saw ~{~S~^; ~}~>" actual)) - -(defmethod print-failure ((type (eql :output)) - form expected actual extras) - (declare (ignore form extras)) - (format t "~& | Should have printed ~{~S~^; ~} " expected) - (format t "~<~%~:;but saw ~{~S~^; ~}~>" actual)) - -(defun print-error (condition) - "Print the error condition." - (let ((*print-escape* nil)) - (format t "~& | Execution error:~% | ~W" condition) - (format t "~& |~%"))) - -(defun print-summary (name pass fail incomplete &optional exerr) - "Print a summary of the test results." - (format t "~&~A: ~S assertions passed, ~S failed, ~S incomplete" - name pass fail incomplete) - (format t "~@[, ~S execution errors~].~2%" exerr)) - -;;; Global unit test database - -(defparameter *test-db* (make-hash-table :test #'eq) - "The unit test database is simply a hash table.") - -(defun package-table (package &optional create) - (cond - ((gethash (find-package package) *test-db*)) - (create - (setf (gethash package *test-db*) (make-hash-table))) - (t (warn "No tests defined for package: ~S" package)))) - -(defclass unit-test () - ((doc - :type string - :initarg :doc - :reader doc) - (code - :type list - :initarg :code - :reader code)) - (:default-initargs :doc "" :code ()) - (:documentation - "Organize the unit test documentation and code.")) - -;;; NOTE: Shamelessly taken from PG's analyze-body -(defun parse-body (body &optional doc) - "Separate the components of the body." - (let ((item (first body))) - (if (and (stringp item) (not doc) (rest body)) - (parse-body (rest body) doc) - (values doc body)))) - -(defmacro define-test (name &body body) - "Store the test in the test database." - (multiple-value-bind (doc code) (parse-body body) - `(let ((doc (or ,doc (string ',name)))) - (setf (gethash ',name (package-table *package* t)) - (make-instance 'unit-test :doc doc :code ',code)) - ',name))) - -;;; Manage tests - -(defun test-count (&optional (package *package*)) - "Returns the number of tests for a package." - (let ((table (package-table package))) - (if table - (hash-table-count table) - 0))) - -(defun test-documentation (name &optional (package *package*)) - "Return the documentation for the test." - (let ((unit-test (gethash name (package-table package)))) - (if (null unit-test) - (warn "No code defined for test ~A in package ~S." - name package) - (doc unit-test)))) - -(defun test-code (name &optional (package *package*)) - "Returns the code stored for the test name." - (let ((unit-test (gethash name (package-table package)))) - (if (null unit-test) - (warn "No code defined for test ~A in package ~S." - name package) - (code unit-test)))) - -(defun remove-tests (names &optional (package *package*)) - "Remove individual tests or entire sets." - (if (eq :all names) - (if (null package) - (clrhash *test-db*) - (remhash (find-package package) *test-db*)) - (let ((table (package-table package))) - (unless (null table) - ;; Remove tests - (loop for name in names - always (remhash name table) - collect name into removed - finally (return removed)))))) - -;;; Assert macros - -(defmacro assert-eq (expected form &rest extras) - "Assert whether expected and form are EQ." - `(expand-assert :equal ,form ,form ,expected ,extras :test #'eq)) - -(defmacro assert-eql (expected form &rest extras) - "Assert whether expected and form are EQL." - `(expand-assert :equal ,form ,form ,expected ,extras :test #'eql)) - -(defmacro assert-equal (expected form &rest extras) - "Assert whether expected and form are EQUAL." - `(expand-assert :equal ,form ,form ,expected ,extras :test #'equal)) - -(defmacro assert-equalp (expected form &rest extras) - "Assert whether expected and form are EQUALP." - `(expand-assert :equal ,form ,form ,expected ,extras :test #'equalp)) - -(defmacro true-or-false? (expected form &rest extras) - "Assert whether expected and form are EQUAL." - `(expand-assert :equal ,form (not (not ,form)) ,expected ,extras :test #'equal)) - -(defmacro assert-error (condition form &rest extras) - "Assert whether form signals condition." - `(expand-assert :error ,form (expand-error-form ,form) - ,condition ,extras)) - -(defmacro assert-expands (expansion form &rest extras) - "Assert whether form expands to expansion." - `(expand-assert :macro ,form - (expand-macro-form ,form nil) - ,expansion ,extras)) - -(defmacro assert-false (form &rest extras) - "Assert whether the form is false." - `(expand-assert :result ,form ,form nil ,extras)) - -(defmacro assert-equality (test expected form &rest extras) - "Assert whether expected and form are equal according to test." - `(expand-assert :equal ,form ,form ,expected ,extras :test ,test)) - -(defmacro assert-prints (output form &rest extras) - "Assert whether printing the form generates the output." - `(expand-assert :output ,form (expand-output-form ,form) - ,output ,extras)) - -(defmacro assert-true (form &rest extras) - "Assert whether the form is true." - `(expand-assert :result ,form ,form t ,extras)) - -(defmacro expand-assert (type form body expected extras &key (test '#'eql)) - "Expand the assertion to the internal format." - `(internal-assert ,type ',form - (lambda () ,body) - (lambda () ,expected) - (expand-extras ,extras) - ,test)) - -(defmacro expand-error-form (form) - "Wrap the error assertion in HANDLER-CASE." - `(handler-case ,form - (condition (error) error))) - -(defmacro expand-output-form (form) - "Capture the output of the form in a string." - (let ((out (gensym))) - `(let* ((,out (make-string-output-stream)) - (*standard-output* - (make-broadcast-stream *standard-output* ,out))) - ,form - (get-output-stream-string ,out)))) - -(defmacro expand-macro-form (form env) - "Expand the macro form once." - `(macroexpand-1 ',form ,env)) - -(defmacro expand-extras (extras) - "Expand extra forms." - `(lambda () - (list ,@(mapcan (lambda (form) (list `',form form)) extras)))) - -;;; Test passed predicate. - -(defgeneric test-passed-p (type expected actual test) - (:documentation - "Return the result of the test.")) - -(defmethod test-passed-p ((type (eql :error)) expected actual test) - "Return the result of the error assertion." - (declare (ignore test)) - (or - (eql (car actual) (car expected)) - (typep (car actual) (car expected)))) - -(defmethod test-passed-p ((type (eql :equal)) expected actual test) - "Return the result of the equality assertion." - (and - (<= (length expected) (length actual)) - (every test expected actual))) - -(defmethod test-passed-p ((type (eql :macro)) expected actual test) - "Return the result of the macro expansion." - (declare (ignore test)) - (equal (car actual) (car expected))) - -(defmethod test-passed-p ((type (eql :output)) expected actual test) - "Return the result of the printed output." - (declare (ignore test)) - (string= - (string-trim '(#\newline #\return #\space) (car actual)) - (car expected))) - -;;; (LOGICALLY-EQUAL x y) => true or false -;;; Return true if x and y both false or both true -(defun logically-equal (x y) - (eql (not x) (not y))) - -(defmethod test-passed-p ((type (eql :result)) expected actual test) - "Return the result of the assertion." - (declare (ignore test)) - (logically-equal (car actual) (car expected))) - -(defun form-contains-one-of-p (form symbol-list) - ;; returns nil if form contains (recursively) no element of the symbol-list - ;; otherwise it returns the first element of symbol-list that it finds - ;; in form. - (cond - ((symbolp form) (find form symbol-list)) - ((listp form) (or (form-contains-one-of-p (car form) symbol-list) - (form-contains-one-of-p (cdr form) symbol-list))) - (t nil))) - -(defun internal-assert - (type form code-thunk expected-thunk extras test) - "Perform the assertion and record the results." - (let* ((expected (multiple-value-list (funcall expected-thunk))) - (actual (multiple-value-list (funcall code-thunk))) - (passed (test-passed-p type expected actual test)) - (incomplete (or (form-contains-one-of-p form +blanks+) - (form-contains-one-of-p expected '(:blank-value))))) - - (cond - (incomplete (progn - (incf *incomplete*) - (push :incomplete *koan-assert-list*))) - (passed (progn - (incf *pass*) - (push :pass *koan-assert-list*))) - (t (progn - (incf *fail*) - (push :fail *koan-assert-list*)))) - ;; Report the assertion - (when (and (not passed) *print-failures*) - (print-failure type form expected actual extras)) - ;; Return the result - passed)) - -;;; results - -(defclass test-results () - ((test-names - :type list - :initarg :test-names - :accessor test-names) - (pass - :type fixnum - :initform 0 - :accessor pass) - (fail - :type fixnum - :initform 0 - :accessor fail) - (incomplete - :type fixnum - :initform 0 - :accessor incomplete) - (exerr - :type fixnum - :initform 0 - :accessor exerr) - (failed-tests - :type list - :initform () - :accessor failed-tests) - (incomplete-tests - :type list - :initform () - :accessor incomplete-tests) - (error-tests - :type list - :initform () - :accessor error-tests) - (missing-tests - :type list - :initform () - :accessor missing-tests)) - (:default-initargs :test-names ()) - (:documentation - "Store the results of the tests for further evaluation.")) - -(defmethod print-object ((object test-results) stream) - "Print the summary counts with the object." - (format stream "#<~A Total(~D) Passed(~D) Failed(~D) Incomplete(~D) Errors(~D)>~%" - (class-name (class-of object)) - (+ (pass object) (fail object) (incomplete object)) - (pass object) (fail object) (incomplete object) (exerr object))) - -(defun summarize-results (results) - "Print a summary of all results." - (let ((pass (pass results)) - (fail (fail results)) - (incomplete (incomplete results))) - (format t "~&Unit Test Summary~%") - (format t " | ~D assertions total~%" (+ pass fail incomplete)) - (format t " | ~D passed~%" pass) - (format t " | ~D failed~%" fail) - (format t " | ~D incomplete~%" incomplete) - (format t " | ~D execution errors~%" (exerr results)) - (format t " | ~D missing tests~2%" - (length (missing-tests results))))) - -;;; Run the tests - -(defun run-code (code) - "Run the code to test the assertions." - (funcall (coerce `(lambda () ,@code) 'function))) - -(defun run-test-thunk (code) - (let ((*pass* 0) - (*fail* 0) - (*incomplete* 0)) - (handler-bind - ((error (lambda (condition) - (when *print-errors* - (print-error condition)) - (if (use-debugger-p condition) - condition - (return-from run-test-thunk - (values *pass* *fail* *incomplete* condition)))))) - (run-code code)) - ;; Return the result count - (values *pass* *fail* *incomplete* nil))) - -(defun run-koan-thunk (code) - (let ((*koan-assert-list* nil)) - (handler-bind - ((error (lambda (condition) - (push :error *koan-assert-list*) - (when *print-errors* - (print-error condition)) - (if (use-debugger-p condition) - condition - (return-from run-koan-thunk - (values *koan-assert-list* condition)))))) - (run-code code)) - ;; Return the result count - (values *koan-assert-list* nil))) - -(defun koan-result (code) - "Run the code. Return a list of assertion result elements. - An assertion result element is one of :pass, :fail, :error, :incomplete" - (run-koan-thunk code)) - -(defun record-result (test-name code results) - "Run the test code and record the result." - (multiple-value-bind (pass fail incomplete exerr) - (run-test-thunk code) - (push test-name (test-names results)) - ;; Count passed tests - (when (plusp pass) - (incf (pass results) pass)) - ;; Count failed tests and record name - (when (plusp fail) - (incf (fail results) fail) - (push test-name (failed-tests results))) - ;; Count incomplete tests and record name - (when (plusp incomplete) - (incf (incomplete results) incomplete) - (push test-name (incomplete-tests results))) - ;; Count errors and record name - (when exerr - (incf (exerr results)) - (push test-name (error-tests results))) - ;; Print a summary of the results - (when (or *print-summary* *print-failures* *print-errors*) - (print-summary - test-name pass fail incomplete (when exerr 1))))) - -(defun %run-all-thunks (&optional (package *package*)) - "Run all of the test thunks in the package." - (loop - with results = (make-instance 'test-results) - for test-name being each hash-key in (package-table package) - using (hash-value unit-test) - if unit-test do - (record-result test-name (code unit-test) results) - else do - (push test-name (missing-tests results)) - ;; Summarize and return the test results - finally - (summarize-results results) - (return results))) - -(defun %run-thunks (test-names &optional (package *package*)) - "Run the list of test thunks in the package." - (loop - with table = (package-table package) - and results = (make-instance 'test-results) - for test-name in test-names - as unit-test = (gethash test-name table) - if unit-test do - (record-result test-name (code unit-test) results) - else do - (push test-name (missing-tests results)) - finally - (summarize-results results) - (return results))) - -(defun run-koans (package) - "Run the list of test thunks in the package. Stopping - at a failure or incomplete, with more helpful messaging" - (loop - with koan-results = nil - for test-name being each hash-key in (package-table package) - using (hash-value unit-test) - if unit-test do - (push (list test-name (koan-result (code unit-test))) koan-results) - else do - (push (list test-name :missing) koan-results) - until (and (not *proceed-after-failure*) (any-non-pass-p koan-results)) - finally (return koan-results))) - -(defun any-non-pass-p (koan-results) - (dolist (one-koan koan-results) - (dolist (assert-result (second one-koan)) - (if (not (equal :pass assert-result)) - (return-from any-non-pass-p t)))) - nil) - -(defun run-tests (test-names &optional (package *package*)) - "Run the specified tests in package." - (if (eq :all test-names) - (%run-all-thunks package) - (%run-thunks test-names package))) diff --git a/test-framework.lsp b/test-framework.lsp new file mode 100644 index 00000000..dea35249 --- /dev/null +++ b/test-framework.lsp @@ -0,0 +1,175 @@ +;;; 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. + +;;; Copyright (c) 2004-2005 Christopher K. Riesbeck +;;; +;;; Permission is hereby granted, free of charge, to any person obtaining +;;; a copy of this software and associated documentation files (the "Software"), +;;; to deal in the Software without restriction, including without limitation +;;; the rights to use, copy, modify, merge, publish, distribute, sublicense, +;;; and/or sell copies of the Software, and to permit persons to whom the +;;; Software is furnished to do so, subject to the following conditions: +;;; +;;; The above copyright notice and this permission notice shall be included +;;; in all copies or substantial portions of the Software. +;;; +;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +;;; OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +;;; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR +;;; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, +;;; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +;;; OTHER DEALINGS IN THE SOFTWARE. + +;;; This version of testing framework is based on LISP-UNIT, extended +;;; to support the lisp koans. Specifically, it is an unnamed branch from +;;; https://github.com/OdonataResearchLLC/lisp-unit/ +;;; with hash 93d07b2fa6e32364916225f6218e9e7313027c1f +;;; +;;; Modifications were made to: +;;; 1) Support *incomplete* tests in addition to *passing* and *failing* ones +;;; 2) End test execution at the first non-passing test +;;; 3) Remove all dead code unrelated to lisp-koans +;;; 4) Rename the system to not collide with the original LISP-UNIT. + +;;; Packages +(defpackage #:com.google.lisp-koans.test + (:use #:common-lisp) + ;; Assertions + (:export #:assert-eq #:assert-eql #:assert-equal #:assert-equalp #:true-or-false? + #:assert-expands #:assert-true #:assert-false #:assert-error) + ;; Manage tests + (:export #:define-test #:test-count #:test-total-count #:run-koans) + ;; Constants for blanks in koans + (:export #:__ #:___ #:____)) + +(in-package #:com.google.lisp-koans.test) + +;; Blank constants allow the incomplete tests to compile without errors. + +(defconstant __ '__) +(defconstant ___ '___) +(defconstant ____ '____) +(defvar +blanks+ '(__ ___ ____)) + +;;; Global unit test database + +(defparameter *test-db* (make-hash-table :test #'eq)) + +(defun package-table (package) + (or (gethash (find-package package) *test-db*) + (setf (gethash package *test-db*) (make-hash-table)))) + +(defmacro define-test (name &body body) + "Store the test in the test database." + `(progn + (setf (gethash ',name (package-table *package*)) ',body) + ',name)) + +;;; Test statistics + +(defun test-count (&optional (package *package*)) + "Returns the number of tests for a package." + (let ((table (package-table package))) + (if table (hash-table-count table) 0))) + +(defun test-total-count () + "Returns the total number of tests." + (loop for table being the hash-value of *test-db* + sum (hash-table-count table))) + +;;; Test passed predicate. + +(defun test-passed-p (type expected actual test) + (ecase type + (:error (or (eql (car actual) (car expected)) (typep (car actual) (car expected)))) + (:equal (and (<= (length expected) (length actual)) (every test expected actual))) + (:macro (equal (car actual) (car expected))) + (:result (eql (not (car actual)) (not (car expected)))))) + +(defun form-contains-blanks-p (form) + (typecase form + (symbol (find form +blanks+)) + (cons (or (form-contains-blanks-p (car form)) + (form-contains-blanks-p (cdr form)))))) + +(defvar *koan-assert-list*) + +(defun internal-assert (type form code-thunk expected-thunk test) + (if (form-contains-blanks-p form) + (push :incomplete *koan-assert-list*) + (let* ((expected (multiple-value-list (funcall expected-thunk))) + (actual (multiple-value-list (funcall code-thunk))) + (passed (test-passed-p type expected actual test)) + (result (if passed :pass :fail))) + (push result *koan-assert-list*)))) + +(defmacro expand-assert (type form body expected &key (test '#'eql)) + `(internal-assert ,type ',form (lambda () ,body) (lambda () ,expected) ,test)) + +;;; Assert macros + +(defmacro assert-eq (expected form) + "Assert whether expected and form are EQ." + `(expand-assert :equal ,form ,form ,expected :test #'eq)) + +(defmacro assert-eql (expected form) + "Assert whether expected and form are EQL." + `(expand-assert :equal ,form ,form ,expected :test #'eql)) + +(defmacro assert-equal (expected form) + "Assert whether expected and form are EQUAL." + `(expand-assert :equal ,form ,form ,expected :test #'equal)) + +(defmacro assert-equalp (expected form) + "Assert whether expected and form are EQUALP." + `(expand-assert :equal ,form ,form ,expected :test #'equalp)) + +(defmacro true-or-false? (expected form) + "Assert whether expected and form are logically equivalent." + `(expand-assert :equal ,form (not (not ,form)) ,expected :test #'equal)) + +(defmacro assert-error (condition form) + "Assert whether form signals condition." + `(expand-assert :error ,form (handler-case ,form (error (e) e)) ,condition)) + +(defmacro assert-expands (expansion form) + "Assert whether form expands to expansion." + `(expand-assert :macro ,form (macroexpand-1 ',form) ,expansion)) + +(defmacro assert-false (form) + "Assert whether the form is false." + `(expand-assert :result ,form ,form nil)) + +(defmacro assert-true (form) + "Assert whether the form is true." + `(expand-assert :result ,form ,form t)) + +;;; Run the tests + +(defun run-koan (code) + (let ((*koan-assert-list* nil)) + (handler-case (funcall (coerce `(lambda () ,@code) 'function)) + (error () (push :error *koan-assert-list*))) + *koan-assert-list*)) + +(defun run-koans (package) + "Run all koans for a given package." + (loop with results = nil + for test-name being each hash-key in (package-table package) + using (hash-value unit-test) + for koan-result = (run-koan unit-test) + do (push (list test-name koan-result) results) + while (every (lambda (x) (eq x :pass)) koan-result) + finally (return results))) From e079b9235c01b18d2625d3f1993e076c824cd4d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 20:09:12 +0200 Subject: [PATCH 073/133] Remove KOAN-DIR-NAME --- lisp-koans.lsp | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/lisp-koans.lsp b/lisp-koans.lsp index b7479d7c..0e25585a 100644 --- a/lisp-koans.lsp +++ b/lisp-koans.lsp @@ -19,8 +19,6 @@ (in-package :com.google.lisp-koans) -(defvar *koan-dir-name* "koans") - (defvar *all-koan-groups* (with-open-file (in #p".koans") (with-standard-io-syntax (read in)))) @@ -40,7 +38,7 @@ (make-package koan-package-name :use '(#:common-lisp #:com.google.lisp-koans.test))) (let ((*package* (find-package koan-package-name))) - (load (concatenate 'string *koan-dir-name* "/" koan-file-name))))) + (load (concatenate 'string "koans/" koan-file-name))))) (defun load-all-koans () (loop for koan-group-name in *all-koan-groups* From fc247220f7f11c0629741cf9dd88311bc1b90610 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 22:52:30 +0200 Subject: [PATCH 074/133] rename greed rules --- koans/{GREED_RULES.txt => extra-credit.txt} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename koans/{GREED_RULES.txt => extra-credit.txt} (100%) diff --git a/koans/GREED_RULES.txt b/koans/extra-credit.txt similarity index 100% rename from koans/GREED_RULES.txt rename to koans/extra-credit.txt From d2bf630733191c2b69305f228cf01bcddb6de307 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 22:54:35 +0200 Subject: [PATCH 075/133] Move *.lsp files to *.lisp --- README.md | 22 +++++++++---------- contemplate.lsp => contemplate.lisp | 6 ++--- koans/{arrays.lsp => arrays.lisp} | 0 koans/{asserts.lsp => asserts.lisp} | 0 ...atoms-vs-lists.lsp => atoms-vs-lists.lisp} | 0 koans/{clos.lsp => clos.lisp} | 0 ...n-handlers.lsp => condition-handlers.lisp} | 0 ...statements.lsp => control-statements.lisp} | 0 koans/{dice-project.lsp => dice-project.lisp} | 0 ...nctions.lsp => equality-distinctions.lisp} | 0 koans/{evaluation.lsp => evaluation.lisp} | 0 koans/{extra-credit.lsp => extra-credit.lisp} | 0 koans/{format.lsp => format.lisp} | 0 koans/{functions.lsp => functions.lisp} | 0 koans/{hash-tables.lsp => hash-tables.lisp} | 0 koans/{iteration.lsp => iteration.lisp} | 0 koans/{lists.lsp => lists.lisp} | 0 koans/{loops.lsp => loops.lisp} | 0 koans/{macros.lsp => macros.lisp} | 0 ...-and-reduce.lsp => mapcar-and-reduce.lisp} | 0 ...ltiple-values.lsp => multiple-values.lisp} | 0 ...l-false-empty.lsp => nil-false-empty.lisp} | 0 ...e-and-extent.lsp => scope-and-extent.lisp} | 0 ...oring-project.lsp => scoring-project.lisp} | 0 .../{special-forms.lsp => special-forms.lisp} | 0 ...d-method-comb.lsp => std-method-comb.lisp} | 0 koans/{strings.lsp => strings.lisp} | 0 koans/{structures.lsp => structures.lisp} | 0 koans/{threads.lsp => threads.lisp} | 0 ...ngle-project.lsp => triangle-project.lisp} | 0 .../{type-checking.lsp => type-checking.lisp} | 0 ...sp => variables-parameters-constants.lisp} | 0 koans/{vectors.lsp => vectors.lisp} | 0 lisp-koans.lsp => lisp-koans.lisp | 6 ++--- meditate-linux.sh | 10 ++++----- meditate-macos.sh | 10 ++++----- test-framework.lsp => test-framework.lisp | 0 ...d-test-ideas.lsp => unused-test-ideas.lisp | 0 38 files changed, 27 insertions(+), 27 deletions(-) rename contemplate.lsp => contemplate.lisp (88%) rename koans/{arrays.lsp => arrays.lisp} (100%) rename koans/{asserts.lsp => asserts.lisp} (100%) rename koans/{atoms-vs-lists.lsp => atoms-vs-lists.lisp} (100%) rename koans/{clos.lsp => clos.lisp} (100%) rename koans/{condition-handlers.lsp => condition-handlers.lisp} (100%) rename koans/{control-statements.lsp => control-statements.lisp} (100%) rename koans/{dice-project.lsp => dice-project.lisp} (100%) rename koans/{equality-distinctions.lsp => equality-distinctions.lisp} (100%) rename koans/{evaluation.lsp => evaluation.lisp} (100%) rename koans/{extra-credit.lsp => extra-credit.lisp} (100%) rename koans/{format.lsp => format.lisp} (100%) rename koans/{functions.lsp => functions.lisp} (100%) rename koans/{hash-tables.lsp => hash-tables.lisp} (100%) rename koans/{iteration.lsp => iteration.lisp} (100%) rename koans/{lists.lsp => lists.lisp} (100%) rename koans/{loops.lsp => loops.lisp} (100%) rename koans/{macros.lsp => macros.lisp} (100%) rename koans/{mapcar-and-reduce.lsp => mapcar-and-reduce.lisp} (100%) rename koans/{multiple-values.lsp => multiple-values.lisp} (100%) rename koans/{nil-false-empty.lsp => nil-false-empty.lisp} (100%) rename koans/{scope-and-extent.lsp => scope-and-extent.lisp} (100%) rename koans/{scoring-project.lsp => scoring-project.lisp} (100%) rename koans/{special-forms.lsp => special-forms.lisp} (100%) rename koans/{std-method-comb.lsp => std-method-comb.lisp} (100%) rename koans/{strings.lsp => strings.lisp} (100%) rename koans/{structures.lsp => structures.lisp} (100%) rename koans/{threads.lsp => threads.lisp} (100%) rename koans/{triangle-project.lsp => triangle-project.lisp} (100%) rename koans/{type-checking.lsp => type-checking.lisp} (100%) rename koans/{variables-parameters-constants.lsp => variables-parameters-constants.lisp} (100%) rename koans/{vectors.lsp => vectors.lisp} (100%) rename lisp-koans.lsp => lisp-koans.lisp (96%) rename test-framework.lsp => test-framework.lisp (100%) rename unused-test-ideas.lsp => unused-test-ideas.lisp (100%) diff --git a/README.md b/README.md index 6f198ddf..3d863f39 100644 --- a/README.md +++ b/README.md @@ -4,18 +4,18 @@ ### One-time Method -From a terminal, execute your lisp interpreter on the file 'contemplate.lsp' e.g. +From a terminal, execute your lisp interpreter on the file 'contemplate.lisp' e.g. - abcl --noinform --noinit --load contemplate.lsp --eval '(quit)' - ccl -n -l contemplate.lsp -e '(quit)' - clisp -q -norc -ansi contemplate.lsp - ecl -norc -load contemplate.lsp -eval '(quit)' - sbcl --script contemplate.lsp + abcl --noinform --noinit --load contemplate.lisp --eval '(quit)' + ccl -n -l contemplate.lisp -e '(quit)' + clisp -q -norc -ansi contemplate.lisp + ecl -norc -load contemplate.lisp -eval '(quit)' + sbcl --script contemplate.lisp ### Watching the Koans On Linux and MacOS systems, the shell scripts `meditate-linux.sh` and -`meditate-macos.sh` can be used to automatically evaluate 'contemplate.lsp' +`meditate-macos.sh` can be used to automatically evaluate 'contemplate.lisp' whenever the koan files are modified, providing immediate feedback on changes to the koans. To run the MacOS version you need to have [`fswatch`](https://github.com/emcrisostomo/fswatch) installed. From a terminal: @@ -36,7 +36,7 @@ You have not yet reached enlightenment ... A koan is incomplete. Please meditate on the following code: - File "koans/asserts.lsp" + File "koans/asserts.lisp" Koan "ASSERT-TRUE" Current koan assert status is "(INCOMPLETE)" @@ -44,7 +44,7 @@ You are now 0/169 koans and 0/25 lessons closer to reaching enlightenment ``` This indicates that the script has completed, and that the learner should look -to asserts.lsp to locate and fix the problem. The problem will be within +to asserts.lisp to locate and fix the problem. The problem will be within a define-test expression such as (define-test assert-true @@ -81,5 +81,5 @@ For information and instructions on installing Quicklisp please see: https://www.quicklisp.org/beta/ The user can either remove #+quicklisp and uncomment -(load "~/.quicklisp/setup.lisp") in threads.lsp, or if they know -quicklisp will be loaded while running contemplate.lsp do nothing. +(load "~/.quicklisp/setup.lisp") in threads.lisp, or if they know +quicklisp will be loaded while running contemplate.lisp do nothing. diff --git a/contemplate.lsp b/contemplate.lisp similarity index 88% rename from contemplate.lsp rename to contemplate.lisp index d252dfd9..eb892bf5 100644 --- a/contemplate.lsp +++ b/contemplate.lisp @@ -15,13 +15,13 @@ (in-package :cl-user) ;;; Though Clozure / CCL runs lisp-koans on the command line using -;;; "ccl -l contemplate.lsp", the following lines are needed to +;;; "ccl -l contemplate.lisp", the following lines are needed to ;;; meditate on the koans within the CCL IDE. ;;; (The :hemlock is used to distiguish between ccl commandline and the IDE) #+(and :ccl :hemlock) (setf *default-pathname-defaults* (directory-namestring *load-pathname*)) -(load "test-framework.lsp") -(load "lisp-koans.lsp") +(load "test-framework.lisp") +(load "lisp-koans.lisp") (com.google.lisp-koans:main) diff --git a/koans/arrays.lsp b/koans/arrays.lisp similarity index 100% rename from koans/arrays.lsp rename to koans/arrays.lisp diff --git a/koans/asserts.lsp b/koans/asserts.lisp similarity index 100% rename from koans/asserts.lsp rename to koans/asserts.lisp diff --git a/koans/atoms-vs-lists.lsp b/koans/atoms-vs-lists.lisp similarity index 100% rename from koans/atoms-vs-lists.lsp rename to koans/atoms-vs-lists.lisp diff --git a/koans/clos.lsp b/koans/clos.lisp similarity index 100% rename from koans/clos.lsp rename to koans/clos.lisp diff --git a/koans/condition-handlers.lsp b/koans/condition-handlers.lisp similarity index 100% rename from koans/condition-handlers.lsp rename to koans/condition-handlers.lisp diff --git a/koans/control-statements.lsp b/koans/control-statements.lisp similarity index 100% rename from koans/control-statements.lsp rename to koans/control-statements.lisp diff --git a/koans/dice-project.lsp b/koans/dice-project.lisp similarity index 100% rename from koans/dice-project.lsp rename to koans/dice-project.lisp diff --git a/koans/equality-distinctions.lsp b/koans/equality-distinctions.lisp similarity index 100% rename from koans/equality-distinctions.lsp rename to koans/equality-distinctions.lisp diff --git a/koans/evaluation.lsp b/koans/evaluation.lisp similarity index 100% rename from koans/evaluation.lsp rename to koans/evaluation.lisp diff --git a/koans/extra-credit.lsp b/koans/extra-credit.lisp similarity index 100% rename from koans/extra-credit.lsp rename to koans/extra-credit.lisp diff --git a/koans/format.lsp b/koans/format.lisp similarity index 100% rename from koans/format.lsp rename to koans/format.lisp diff --git a/koans/functions.lsp b/koans/functions.lisp similarity index 100% rename from koans/functions.lsp rename to koans/functions.lisp diff --git a/koans/hash-tables.lsp b/koans/hash-tables.lisp similarity index 100% rename from koans/hash-tables.lsp rename to koans/hash-tables.lisp diff --git a/koans/iteration.lsp b/koans/iteration.lisp similarity index 100% rename from koans/iteration.lsp rename to koans/iteration.lisp diff --git a/koans/lists.lsp b/koans/lists.lisp similarity index 100% rename from koans/lists.lsp rename to koans/lists.lisp diff --git a/koans/loops.lsp b/koans/loops.lisp similarity index 100% rename from koans/loops.lsp rename to koans/loops.lisp diff --git a/koans/macros.lsp b/koans/macros.lisp similarity index 100% rename from koans/macros.lsp rename to koans/macros.lisp diff --git a/koans/mapcar-and-reduce.lsp b/koans/mapcar-and-reduce.lisp similarity index 100% rename from koans/mapcar-and-reduce.lsp rename to koans/mapcar-and-reduce.lisp diff --git a/koans/multiple-values.lsp b/koans/multiple-values.lisp similarity index 100% rename from koans/multiple-values.lsp rename to koans/multiple-values.lisp diff --git a/koans/nil-false-empty.lsp b/koans/nil-false-empty.lisp similarity index 100% rename from koans/nil-false-empty.lsp rename to koans/nil-false-empty.lisp diff --git a/koans/scope-and-extent.lsp b/koans/scope-and-extent.lisp similarity index 100% rename from koans/scope-and-extent.lsp rename to koans/scope-and-extent.lisp diff --git a/koans/scoring-project.lsp b/koans/scoring-project.lisp similarity index 100% rename from koans/scoring-project.lsp rename to koans/scoring-project.lisp diff --git a/koans/special-forms.lsp b/koans/special-forms.lisp similarity index 100% rename from koans/special-forms.lsp rename to koans/special-forms.lisp diff --git a/koans/std-method-comb.lsp b/koans/std-method-comb.lisp similarity index 100% rename from koans/std-method-comb.lsp rename to koans/std-method-comb.lisp diff --git a/koans/strings.lsp b/koans/strings.lisp similarity index 100% rename from koans/strings.lsp rename to koans/strings.lisp diff --git a/koans/structures.lsp b/koans/structures.lisp similarity index 100% rename from koans/structures.lsp rename to koans/structures.lisp diff --git a/koans/threads.lsp b/koans/threads.lisp similarity index 100% rename from koans/threads.lsp rename to koans/threads.lisp diff --git a/koans/triangle-project.lsp b/koans/triangle-project.lisp similarity index 100% rename from koans/triangle-project.lsp rename to koans/triangle-project.lisp diff --git a/koans/type-checking.lsp b/koans/type-checking.lisp similarity index 100% rename from koans/type-checking.lsp rename to koans/type-checking.lisp diff --git a/koans/variables-parameters-constants.lsp b/koans/variables-parameters-constants.lisp similarity index 100% rename from koans/variables-parameters-constants.lsp rename to koans/variables-parameters-constants.lisp diff --git a/koans/vectors.lsp b/koans/vectors.lisp similarity index 100% rename from koans/vectors.lsp rename to koans/vectors.lisp diff --git a/lisp-koans.lsp b/lisp-koans.lisp similarity index 96% rename from lisp-koans.lsp rename to lisp-koans.lisp index 0e25585a..d754cea4 100644 --- a/lisp-koans.lsp +++ b/lisp-koans.lisp @@ -32,7 +32,7 @@ (defun load-koan-group-named (koan-group-name) (let* ((koan-name (string-downcase (string koan-group-name))) - (koan-file-name (concatenate 'string koan-name ".lsp")) + (koan-file-name (concatenate 'string koan-name ".lisp")) (koan-package-name (package-name-from-group-name koan-group-name))) (unless (find-package koan-package-name) (make-package koan-package-name @@ -96,7 +96,7 @@ (format t "You have not yet reached enlightenment. ~A Please meditate on the following code: - File \"koans/~(~A~).lsp\" + File \"koans/~(~A~).lisp\" Koan \"~A\" Current koan assert status is \"~A\"~%~%" (koan-status-message koan-status) filename koan-name koan-status))) @@ -106,7 +106,7 @@ That was the last one, well done! ENLIGHTENMENT IS YOURS! ********************************************************* -If you demand greater challenge, take a look at extra-credit.lsp +If you demand greater challenge, take a look at extra-credit.lisp Or, let the student become the teacher: Write and submit your own improvements to https://github.com/google/lisp-koans! ")) diff --git a/meditate-linux.sh b/meditate-linux.sh index 048dda85..1a811327 100644 --- a/meditate-linux.sh +++ b/meditate-linux.sh @@ -9,19 +9,19 @@ fi choose_command_line() { case "$1" in 'abcl' ) - echo "abcl --noinform --noinit --load contemplate.lsp --eval '(quit)'" + echo "abcl --noinform --noinit --load contemplate.lisp --eval '(quit)'" ;; 'ccl' ) - echo "ccl -n -l contemplate.lsp -e '(quit)'" + echo "ccl -n -l contemplate.lisp -e '(quit)'" ;; 'clisp' ) - echo "clisp -q -norc -ansi contemplate.lsp" + echo "clisp -q -norc -ansi contemplate.lisp" ;; 'ecl' ) - echo "ecl -norc -load contemplate.lsp -eval '(quit)'" + echo "ecl -norc -load contemplate.lisp -eval '(quit)'" ;; 'sbcl' ) - echo "sbcl --script contemplate.lsp" + echo "sbcl --script contemplate.lisp" ;; * ) echo "" diff --git a/meditate-macos.sh b/meditate-macos.sh index 8ac0116c..ca184013 100644 --- a/meditate-macos.sh +++ b/meditate-macos.sh @@ -9,19 +9,19 @@ fi choose_command_line() { case "$1" in 'abcl' ) - echo "abcl --noinform --noinit --load contemplate.lsp --eval '(quit)'" + echo "abcl --noinform --noinit --load contemplate.lisp --eval '(quit)'" ;; 'ccl' ) - echo "ccl -n -l contemplate.lsp -e '(quit)'" + echo "ccl -n -l contemplate.lisp -e '(quit)'" ;; 'clisp' ) - echo "clisp -q -norc -ansi contemplate.lsp" + echo "clisp -q -norc -ansi contemplate.lisp" ;; 'ecl' ) - echo "ecl -norc -load contemplate.lsp -eval '(quit)'" + echo "ecl -norc -load contemplate.lisp -eval '(quit)'" ;; 'sbcl' ) - echo "sbcl --script contemplate.lsp" + echo "sbcl --script contemplate.lisp" ;; * ) echo "" diff --git a/test-framework.lsp b/test-framework.lisp similarity index 100% rename from test-framework.lsp rename to test-framework.lisp diff --git a/unused-test-ideas.lsp b/unused-test-ideas.lisp similarity index 100% rename from unused-test-ideas.lsp rename to unused-test-ideas.lisp From cb6dbe491904117e2d0bebd8343b078b811326ae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Tue, 5 May 2020 23:35:26 +0200 Subject: [PATCH 076/133] ASSERT-TRUE now takes generalized booleans --- test-framework.lisp | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/test-framework.lisp b/test-framework.lisp index dea35249..c9d30900 100644 --- a/test-framework.lisp +++ b/test-framework.lisp @@ -104,6 +104,8 @@ (cons (or (form-contains-blanks-p (car form)) (form-contains-blanks-p (cdr form)))))) +(defun notnot (x) (not (not x))) + (defvar *koan-assert-list*) (defun internal-assert (type form code-thunk expected-thunk test) @@ -154,7 +156,7 @@ (defmacro assert-true (form) "Assert whether the form is true." - `(expand-assert :result ,form ,form t)) + `(expand-assert :result ,form ,form t :test #'notnot)) ;;; Run the tests From bffb7bd556c1df79351dfcdce7df1347dbdd613b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Wed, 6 May 2020 16:30:52 +0200 Subject: [PATCH 077/133] Begin reworking koan list --- .koans | 59 ++++----- koans/arrays.lisp | 83 ++++++------- koans/asserts.lisp | 84 ++++++++----- koans/atoms-vs-lists.lisp | 91 +++++++------- koans/basic-macros.lisp | 117 ++++++++++++++++++ koans/evaluation.lisp | 114 +++++++++--------- koans/let.lisp | 62 ++++++++++ koans/lists.lisp | 239 ++++++++++++++++++++++--------------- koans/nil-false-empty.lisp | 107 ++++++++--------- koans/special-forms.lisp | 147 ----------------------- test-framework.lisp | 18 +-- 11 files changed, 603 insertions(+), 518 deletions(-) create mode 100644 koans/basic-macros.lisp create mode 100644 koans/let.lisp delete mode 100644 koans/special-forms.lisp diff --git a/.koans b/.koans index da971924..bf11e5fb 100644 --- a/.koans +++ b/.koans @@ -1,31 +1,32 @@ ( - :asserts - :nil-false-empty - :evaluation - :atoms-vs-lists - :special-forms - :lists - :arrays - :vectors - :multiple-values - :equality-distinctions - :hash-tables - :functions - :strings - :structures - :iteration - :mapcar-and-reduce - :control-statements - :condition-handlers - :loops - :triangle-project - :scoring-project - :format - :type-checking - :clos - :std-method-comb - :dice-project - :macros - :scope-and-extent - #+quicklisp :threads + #:asserts + #:nil-false-empty + #:evaluation + #:atoms-vs-lists + #:let + #:basic-macros + #:lists + #:arrays + #:vectors + #:multiple-values + #:equality-distinctions + #:hash-tables + #:functions + #:strings + #:structures + #:iteration + #:mapcar-and-reduce + #:control-statements + #:condition-handlers + #:loops + #:triangle-project + #:scoring-project + #:format + #:type-checking + #:clos + #:std-method-comb + #:dice-project + #:macros + #:scope-and-extent + #+quicklisp #:threads ) diff --git a/koans/arrays.lisp b/koans/arrays.lisp index 873a1579..c00c17fa 100644 --- a/koans/arrays.lisp +++ b/koans/arrays.lisp @@ -1,46 +1,43 @@ -;; 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. - - -;; see http://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node157.html +;;; 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. +;;; See http://www.gigamonkeys.com/book/collections.html (define-test test-basic-array-stuff - " the first block of code defines an 8x8 array, then fills - the elements with a checkerboard pattern" - (let ((chess-board)) - (setf chess-board (make-array '(8 8))) - "this dotimes is an iterator which loops x over integers 0 to 7" + "We define an 8x8 array and then fill it with a checkerboard pattern." + (let ((chess-board (make-array '(8 8)))) + "(DOTIMES (X 8) ...) will iterate with X taking values from 0 to 7." (dotimes (x 8) (dotimes (y 8) - (if (evenp (+ x y)) - (setf (aref chess-board x y) :black) - (setf (aref chess-board x y) :white) - ))) + "AREF stands for \"array reference\"." + (setf (aref chess-board x y) (if (evenp (+ x y)) :black :white)))) (assert-true (typep chess-board 'array)) - (assert-equal (aref chess-board 0 0) ___) - (assert-equal (aref chess-board 2 3) ___) - "array-rank returns the number of dimensions of the array" - (assert-equal ___ (array-rank chess-board)) - "array-dimensions returns a list of the cardinality of the array dims" - (assert-equal ___ (array-dimensions chess-board)) - (assert-equal ___ (array-total-size chess-board)))) + (assert-equal (aref chess-board 0 0) ____) + (assert-equal (aref chess-board 2 3) ____) + "ARRAY-RANK returns the number of dimensions of the array." + (assert-equal ____ (array-rank chess-board)) + "ARRAY-DIMENSIONS returns a list of the cardinality of the array dims" + (assert-equal ____ (array-dimensions chess-board)) + "ARRAY-TOTAL-SIZE returns the total number of elements in the array." + (assert-equal ____ (array-total-size chess-board)))) (define-test test-make-your-own-array - "make your own array that meets the specifications below." - (let ((color-cube nil)) - "you may need to modify your array after you make it" + "Make your own array that meets the specifications below." + (let ((color-cube ____)) + "You may need to modify your array after you create it." + (setf (____ color-cube ____ ____ ____) ____ + (____ color-cube ____ ____ ____) ____) (if (typep color-cube '(simple-array T (3 3 3))) (progn (assert-equal 3 (array-rank color-cube)) @@ -50,28 +47,24 @@ (assert-equal (aref color-cube 2 1 0) :white)) (assert-true nil)))) - (define-test test-adjustable-array - "one may build arrays that can change size" + "The size of an array does not need to be constant." (let ((x (make-array '(2 2) :initial-element 5 :adjustable t))) (assert-equal (aref x 1 0) ____) (assert-equal (array-dimensions x) ____) (adjust-array x '(3 4)) (assert-equal (array-dimensions x) ____))) - (define-test test-make-array-from-list - (let ((x)) - (setf x (make-array '(4) :initial-contents '(:one :two :three :four))) + "One can create arrays from list structure." + (let ((x (make-array '(4) :initial-contents '(:one :two :three :four)))) (assert-equal (array-dimensions x) ____) (assert-equal ____ (aref x 0)))) - (define-test test-row-major-index - "row major indexing is a way to access elements with a single integer, - rather than a list of integers" - (let ((my-array nil)) - (setf my-array (make-array '(2 2 2 2))) + "Row major indexing is a way to access elements with a single integer, + rather than a list of integers." + (let ((my-array (make-array '(2 2 2 2)))) (dotimes (i (* 2 2 2 2)) (setf (row-major-aref my-array i) i)) (assert-equal (aref my-array 0 0 0 0) ____) diff --git a/koans/asserts.lisp b/koans/asserts.lisp index 806ac3a6..8093e150 100644 --- a/koans/asserts.lisp +++ b/koans/asserts.lisp @@ -1,47 +1,65 @@ -;; 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. +;;; 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. +;;; ╭╮ ╭╮ /////// +;;; ┃┃ ┃┃/////// +;;; ┃┃╭┳━━┳━━╮ ┃┃╭┳━━┳━━┳━╮╭━━╮ +;;; ┃┃┣┫━━┫╭╮┃ ┃╰╯┫╭╮┃╭╮┃╭╮┫━━┫ +;;; ┃╰┫┣━━┃╰╯┃ ┃╭╮┫╰╯┃╭╮┃┃┃┣━━┃ +;;; ╰━┻┻━━┫╭━╯/╰╯╰┻━━┻╯╰┻╯╰┻━━╯ +;;; ┃┃ ////// +;;; ╰╯////// -; Concept: What do you do to go through the lisp koans? You fill in -; the blanks, or otherwise fix the lisp code so that the -; code within the 'define-test' blocks passes. +;;; Welcome to the Lisp Koans. +;;; May the code stored here influence your enlightenment as a programmer. +;;; In order to progress, fill in the blanks, denoted via ____ in source code. +;;; Sometimes, you will be asked to provide values that are equal to something. -; In common lisp, "True" and "False" are represented by "t" and "nil". -; More in a future lesson, but for now, consider t to be true, -; and nil to be false. +(define-test fill-in-the-blanks + (assert-equal ____ 2) + (assert-equal ____ 3.14) + (assert-equal ____ "Hello World")) +;;; Sometimes, you will be asked to say whether something is true or false, +;;; In Common Lisp, the canonical values for truth and falsehood are T and NIL. (define-test assert-true - "t is true. Replace the blank with a t" - (assert-true ___)) + (assert-true ____)) (define-test assert-false - "nil is false" - (assert-false ___)) + (assert-false ____)) -(define-test fill-in-the-blank - "sometimes you will need to fill the blank to complete" - (assert-equal 2 ___)) +(define-test true-or-false + (true-or-false? ____ (= 34 34)) + (true-or-false? ____ (= 19 78))) -(define-test fill-in-the-blank-string - (assert-equal ___ "hello world")) +;;; Since T and NIL are symbols, you can type them in lowercase or uppercase; +;;; by default, Common Lisp will automatically upcase them upon reading. -(define-test test-true-or-false - "sometimes you will be asked to evaluate whether statements - are true (t) or false (nil)" - (true-or-false? ___ (equal 34 34)) - (true-or-false? ___ (equal 19 78))) +(define-test upcase-downcase + ;; Try inserting a lowercase t here. + (assert-equal ____ T) + ;; Try inserting an uppercase NIL here. + (assert-equal ____ nil)) +;;; Sometimes, you will be asked to provide a part of an expression that must be +;;; either true or false. + +(define-test a-true-assertion + (assert-true (= ____ (+ 2 2)))) + +(define-test a-false-assertion + (assert-false (= ____ (+ 2 2)))) diff --git a/koans/atoms-vs-lists.lisp b/koans/atoms-vs-lists.lisp index ce49da87..62de29f1 100644 --- a/koans/atoms-vs-lists.lisp +++ b/koans/atoms-vs-lists.lisp @@ -1,48 +1,43 @@ -;; 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. - - -(define-test test-list-or-atom - "Lists in lisp are forms beginning and ending with rounded parentheses. - Atoms are symbols, numbers, or other forms usually separated by - white-space or parentheses. The function 'listp' will return true if - the input is a list. The function 'atom' will return true if the - input is an atom." - (true-or-false? ___ (listp '(1 2 3))) - (true-or-false? ___ (atom '(1 2 3))) - - (true-or-false? ___ (listp '("heres" "some" "strings"))) - (true-or-false? ___ (atom '("heres" "some" "strings"))) - - (true-or-false? ___ (listp "a string")) - (true-or-false? ___ (atom "a string")) - - (true-or-false? ___ (listp 2)) - (true-or-false? ___ (atom 2)) - - (true-or-false? ___ (listp '(("first" "list") ("second" "list")))) - (true-or-false? ___ (atom '(("first" "list") ("second" "list"))))) - - -(define-test test-empty-list-is-both-list-and-atom - "the empty list, nil, is unique in that it is both a list and an atom" - (true-or-false? ___ (listp nil)) - (true-or-false? ___ (atom nil))) - - -(define-test test-keywords - "symbols like :hello or :like-this are treated differently in lisp. - Called keywords, they are symbols that evaluate to themselves." - (true-or-false? ___ (equal :this-is-a-keyword :this-is-a-keyword)) - (true-or-false? ___ (equal :this-is-a-keyword ':this-is-a-keyword))) +;;; 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. + +;;; Lists in lisp are forms beginning and ending with rounded parentheses. +;;; Atoms are symbols, numbers, or other forms usually separated by whitespace +;;; or parentheses. + +(define-test list-or-atom + ;; The function LISTP will return true if the input is a list. + ;; The function ATOM will return true if the input is an atom. + (true-or-false? ____ (listp '(1 2 3))) + (true-or-false? ____ (atom '(1 2 3))) + (true-or-false? ____ (listp '("heres" "some" "strings"))) + (true-or-false? ____ (atom '("heres" "some" "strings"))) + (true-or-false? ____ (listp "a string")) + (true-or-false? ____ (atom "a string")) + (true-or-false? ____ (listp 2)) + (true-or-false? ____ (atom 2)) + (true-or-false? ____ (listp '(("first" "list") ("second" "list")))) + (true-or-false? ____ (atom '(("first" "list") ("second" "list"))))) + +(define-test the-duality-of-nil + ;; The empty list, NIL, is unique in that it is both a list and an atom. + (true-or-false? ____ (listp nil)) + (true-or-false? ____ (atom nil))) + +(define-test keywords + ;; Symbols like :HELLO or :LIKE-THIS are keywords. They are treated + ;; differently in Lisp: they are constants that always evaluate to themselves. + (true-or-false? ____ (equal :this-is-a-keyword :this-is-a-keyword)) + (true-or-false? ____ (equal :this-is-a-keyword ':this-is-a-keyword)) + (true-or-false? ____ (equal :this-is-a-keyword :this-is-also-a-keyword))) diff --git a/koans/basic-macros.lisp b/koans/basic-macros.lisp new file mode 100644 index 00000000..dc1d8dd0 --- /dev/null +++ b/koans/basic-macros.lisp @@ -0,0 +1,117 @@ +;;; 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. + +(define-test setf + ;; SETF is a macro used to assign values to places. A place is a concept; + ;; it is an abstract "somewhere" where a value is stored. + (let ((a 10) + (b (list 1 20 30 40 50)) + ;; We use COPY-SEQ to create a copy of a string, because using SETF to + ;; modify literal data (strings, lists, etc.) is undefined behaviour. + (c (copy-seq "I am Tom."))) + ;; A place may be a variable. + (setf a 1000) + (assert-equal ____ a) + ;; A place may be a part of some list. + (setf (first b) 10) + (assert-equal ____ b) + ;; A place may be a character in a string. + ;; The #\x syntax denotes a single character, 'x'. + (setf (char c 5) #\B + (char c 7) #\b) + (assert-equal ____ c) + ;; There are other kinds of places that we will explore in the future. + )) + +(define-test case + ;; CASE is a simple pattern-matching macro, not unlike C's "switch". + ;; It compares an input against a set of values and evaluates the code for + ;; the branch where a match is found. + (let* ((a 4) + (b (case a + (3 :three) + (4 :four) + (5 :five)))) + (assert-equal ____ b)) + ;; CASE can accept a group of keys. + (let* ((c 4) + (d (case c + ((0 2 4 6 8) :even-digit) + ((1 3 5 7 9) :odd-digit)))) + (assert-equal ____ d))) + +(defun match-special-cases (thing) + ;; T or OTHERWISE passed as the key matches any value. + ;; NIL passed as the key matches no values. + ;; These symbols need to passed in parentheses. + (case thing + (____ :found-a-t) + (____ :found-a-nil) + (____ :something-else))) + +(define-test special-cases-of-case + ;; You need to fill in the blanks in MATCH-SPECIAL-CASES. + (assert-equal :found-a-t (case-special-symbols-match t)) + (assert-equal :found-a-nil (case-special-symbols-match nil)) + (assert-equal :something-else (case-special-symbols-match 42))) + +(defun cartoon-dads (input) + (case input + ;; Fill in the blanks with proper cases. + ____ + ____ + ____ + (:this-one-doesnt-happen :fancy-cat) + (t :unknown))) + +(define-test your-own-case-statement + ;; You need to fill in the blanks in CARTOON-DADS. + (assert-equal (cartoon-dads :bart) :homer) + (assert-equal (cartoon-dads :stewie) :peter) + (assert-equal (cartoon-dads :stan) :randy) + (assert-equal (cartoon-dads :space-ghost) :unknown)) + +(define-test limits-of-case + ;; So far, we have been comparing objects using EQUAL, one of the Lisp + ;; comparison functions. CASE compares the keys using EQL, which is distinct + ;; from EQUAL. + ;; EQL is suitable for comparing numbers, characters, and objects for whom we + ;; want to check verify they are the same object. + (let ((string "A string") + (string-copy (copy-seq string))) + ;; The above means that two distinct strings will not be the same under EQL, + ;; even if they have the same contents. + (true-or-false? ____ (eql string string-copy)) + (true-or-false? ____ (equal string string-copy)) + ;; The above also means that CASE might give surprising results when used on + ;; strings. + (let ((match-1 (case string + (string-copy :matched) + (t :not-matched))) + (match-2 (case string + (string :matched) + (t :not-matched)))) + (assert-equal ____ match-1) + (assert-equal ____ match-2)) + ;; We will explore this topic further in the EQUALITY-DISTINCTIONS lesson. + )) + +(define-test cond + ;; COND is similar to CASE, except it is more general. It accepts arbitrary + ;; conditions and checks them in order until one of them is met. + (let* ((number 4) + (result (cond ((> number 0) :positive) + ((< number 0) :negative) + (t :zero)))) + (assert-equal ____ result))) diff --git a/koans/evaluation.lisp b/koans/evaluation.lisp index 47e56c7e..176b3187 100644 --- a/koans/evaluation.lisp +++ b/koans/evaluation.lisp @@ -1,64 +1,66 @@ -;; 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. +;;; 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. +;;; In most imperative languages, the syntax of a function call has the function +;;; name succeeded by a list of arguments. In Lisp, the function name and +;;; arguments are all part of the same list, with the function name the first +;;; element of that list. -;; Based on "Successful Lisp" by David B. Lamkins -;; Download link to archive https://successful-lisp.blogspot.com/p/httpsdrive.html -;; Or buy the Book via : https://successful-lisp.blogspot.com/ +(define-test function-names + ;; In these examples, +, -, *, and / are function names. + (assert-equal ____ (+ 2 3)) + (assert-equal ____ (- 1 3)) + (assert-equal ____ (* 7 4)) + (assert-equal ____ (/ 100 4))) +(define-test numberp + ;; NUMBERP is a predicate which returns true if its argument is a number. + (assert-equal ____ (numberp 5)) + (assert-equal ____ (numberp 2.0)) + (assert-equal ____ (numberp "five"))) -(define-test test-function-name-is-first-argument - "In most imperative languages, the syntax of a function call has - the function name succeeded by a list of arguments. In lisp, - the function name and arguments are all part of the same list, - with the function name the first element of that list." +(define-test evaluation-order + ;; Arguments to a function are evaluated before the function is called. + (assert-equal ____ (* (+ 1 2) (- 13 10)))) - "in these examples, the function names are +, -, and *" - (assert-equal ___ (+ 2 3)) - (assert-equal ___ (- 1 3)) - (assert-equal ___ (* 7 4)) - "'>' and '=' are the boolean functions (predicates) 'greater-than' and - 'equal to'" - (assert-equal ___ (> 100 4)) - (assert-equal ___ (= 3 3)) - "'NUMBERP' is a predicate which returns true if the argument is a number" - (assert-equal ___ (numberp 5)) - (assert-equal ___ (numberp "five"))) +(define-test basic-arithmetic + ;; The below functions are boolean functions (predicates) that operate on + ;; numbers. + (assert-equal ____ (> 25 4)) + (assert-equal ____ (< 8 2)) + (assert-equal ____ (= 3 3)) + (assert-equal ____ (<= 6 (/ 12 2))) + (assert-equal ____ (>= 20 (+ 1 2 3 4 5))) + (assert-equal ____ (/= 15 (+ 4 10)))) - -(define-test test-evaluation-order - "Arguments to functions are evaluated before the function" - (assert-equal ___ (* (+ 1 2) (- 13 10)))) - - -(define-test test-quoting-behavior - "Preceding a list with a quote (') will tell lisp not to evaluate a list. - The quote special form suppresses normal evaluation, and instead returns - the literal list. - Evaluating the form (+ 1 2) returns the number 3, - but evaluating the form '(+ 1 2) returns the list (+ 1 2)" +(define-test quote + ;; Preceding a list with a quote (') will tell Lisp not to evaluate a list. + ;; The quote special form suppresses normal evaluation, and instead returns + ;; the literal list. + ;; Evaluating the form (+ 1 2) returns the number 3, but evaluating the form + ;; '(+ 1 2) returns the list (+ 1 2). (assert-equal ____ (+ 1 2)) (assert-equal ____ '(+ 1 2)) - "'LISTP' is a predicate which returns true if the argument is a list - the '(CONTENTS) form defines a list literal containing CONTENTS" - (assert-equal ___ (listp '(1 2 3))) - (assert-equal ___ (listp 100)) - (assert-equal ___ (listp "Word to your moms I came to drop bombs")) - (assert-equal ___ (listp nil)) - (assert-equal ___ (listp (+ 1 2))) - (assert-equal ___ (listp '(+ 1 2))) - "equalp is an equality predicate" - (assert-equal ___ (equalp 3 (+ 1 2))) - "the '(xyz ghi) syntax is syntactic sugar for the (QUOTE (xyz ghi)) function." - (true-or-false? ___ (equalp '(/ 4 0) (quote (/ 4 0))))) + (assert-equal ____ (list '+ 1 2)) + ;; The 'X syntax is syntactic sugar for (QUOTE X). + (true-or-false? ____ (equal '(/ 4 0) (quote (/ 4 0))))) + +(define-test listp + ;; LISTP is a predicate which returns true if the argument is a list. + (assert-equal ____ (listp '(1 2 3))) + (assert-equal ____ (listp 100)) + (assert-equal ____ (listp "Hello world")) + (assert-equal ____ (listp nil)) + (assert-equal ____ (listp (+ 1 2))) + (assert-equal ____ (listp '(+ 1 2)))) diff --git a/koans/let.lisp b/koans/let.lisp new file mode 100644 index 00000000..fef4a9a2 --- /dev/null +++ b/koans/let.lisp @@ -0,0 +1,62 @@ +;;; 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. + +(define-test let + ;; The LET form establishes a lexical extent within which new variables are + ;; created: a symbol that names a variable becomes bound to a value. + (let ((x 10) + (y 20)) + (assert-equal (+ x y) ____) + ;; It is possible to shadow previously visible bindings. + (let ((y 30)) + (assert-equal (+ x y) ____)) + (assert-equal (+ x y) ____)) + ;; Variables bound by LET have a default value of NIL. + (let (x) + (assert-equal x ____))) + +(define-test let-versus-let* + ;; LET* is similar to LET, except the bindings are established sequentially, + ;; and a binding may use bindings that were established before it. + (let ((x 10) + (y 20)) + (let ((x (+ y 100)) + (y (+ x 100))) + (assert-equal ____ x) + (assert-equal ____ y)) + (let* ((x (+ y 100)) + (y (+ x 100))) + ;; Which X is used to compute the value of Y? + (assert-equal ____ x) + (assert-equal ____ y)))) + +(define-test let-it-be-equal + ;; Fill in the LET and LET* to get the tests to pass. + (let ((a 1) + (b :two) + (c "Three")) + (let ((____ ____) + (____ ____) + (____ ____)) + (assert-equal a 100) + (assert-equal b 200) + (assert-equal c "Jellyfish")) + (let* ((____ ____) + (____ ____) + ;; In this third binding, you are allowed to use the variables bound + ;; by the previous two LET* bindings. + (____ ____)) + (assert-equal a 121) + (assert-equal b 200) + (assert-equal c (+ a (/ b a)))))) diff --git a/koans/lists.lisp b/koans/lists.lisp index e64f88fa..5cdc4e69 100644 --- a/koans/lists.lisp +++ b/koans/lists.lisp @@ -1,109 +1,156 @@ -;; 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. - - -;; based on python koans 'about_lists.py' -;; based also on "Lisp 3rd Edition" ch. 17. "List storage, surgery and reclamation" - - -(define-test test-creating-lists - "lists can be created using the quote form, or the 'list' function" - (let ((fruits nil) - (some-evens nil)) - (setf fruits '(orange pomello clementine)) - (setf some-evens (list (* 2 1) (* 2 2) (* 2 3))) - (assert-equal fruits ___) - (assert-equal ___ (length some-evens)))) - - -(define-test test-list-cons - "cons CONStructs new lists, by prefixing some list with - a new element like (cons new-element some-list)" - (let ((nums nil)) - (setf nums (cons :one nums)) - (assert-equal '(:one) nums) - - (setf nums (cons :two nums)) - (assert-equal ___ nums) - - "lists can contain anything, even mixtures of different things" - (setf nums (cons 333 nums)) - (assert-equal ___ nums) - - "lists can of course contain lists" - (setf nums (cons '("the" "rest") nums)) - (assert-equal ___ nums))) - - -(define-test test-push-pop - (let ((stack '(10 20 30 40)) - (firstval nil)) - "push adds an element to the beginning of a list referred to by some symbol" - (push "last" stack) - (assert-equal '("last" 10 20 30 40) stack) - - "pop is the opposite of push. - It removes and returns the first element of a list" - (setf firstval (pop stack)) - (assert-equal "last" firstval) - (assert-equal '(10 20 30 40) stack) - - (setf firstval (pop stack)) - (assert-equal ___ firstval) - (assert-equal ___ stack))) - - -(define-test test-append - "append attaches one list to the end of another." - (assert-equal '(:a :b :c) (append '(:a :b) '(:c))) - - (let ((abc '(:a :b :c)) - (xyz '(:x :y :z)) - (abcxyz nil)) - (setf abcxyz (append abc xyz)) - (assert-equal ___ abc) - (assert-equal ___ xyz) - (assert-equal ___ abcxyz))) - +;;; 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. + +;;; A singly linked list is the basic build block of Lisp. Each node of such a +;;; list is called a "cons cell" in Lisp. Each cons cell has two slots: a CAR, +;;; often used to hold an element of a list, and a CDR, often used to reference +;;; the next cons cell. + +(define-test how-to-make-lists + (let (;; Literal lists can be passed by quoting them. + (fruits '(orange pomello clementine)) + ;; Freshly constructed lists can be passed using the LIST function. + (some-evens (list (* 2 1) (* 2 2) (* 2 3))) + ;; Lists can also be passed using quotes and dot notation... + (long-numbers '(16487302 . (3826700034 . (10000000 . '())))) + ;; ...or by using the function CONS. + (names (cons "Matthew" (cons "Mark" (cons "Margaret" '()))))) + ;; Try filling in the below blanks in different ways. + (assert-equal ____ fruits) + (assert-equal ____ some-evens) + (assert-equal ____ long-numbers) + (assert-equal ____ names))) + +(define-test cons-tructing-lists + ;; The function CONS can be used to add new elements at the beginning of + ;; an existing list. + (let ((nums '())) + (setf nums (cons :one nums)) + (assert-equal ____ nums) + (setf nums (cons :two nums)) + (assert-equal ____ nums) + ;; Lists can contain anything, even objects of different types. + (setf nums (cons 333 nums)) + (assert-equal ____ nums) + ;; Lists can contain other lists, too. + (setf nums (cons (list "some" "strings") nums)) + (assert-equal ____ nums))) + +(define-test car-and-cdr + ;; We may use functions CAR and CDR (or, alternatively, FIRST and REST) to + ;; access the two slots of a cons cell. + (let ((x (cons 1 2))) + (assert-equal ____ (car x)) + (assert-equal ____ (cdr x))) + ;; Calls to CAR and CDR are often intertwined to extract data from a nested + ;; cons structure. + (let ((structure '((1 2) (("foo" . "bar"))))) + (assert-equal ____ (car x)) + (assert-equal ____ (car (cdr x))) + (assert-equal ____ (cdr (car (car (cdr x))))) + ;; Lisp defines shorthand functions for up to four such nested calls. + (assert-equal ____ (car x)) + (assert-equal ____ (cadr x)) + (assert-equal ____ (cdaadr x)))) + +(define-test cons-tructing-improper-lists + ;; A proper list is a list whose final CDR ends with NIL. + ;; An improper list either has a non-NIL value in its final CDR or does not + ;; have a final CDR due to a cycle in its structure. + (let (;; We can construct non-cyclic improper lists using LIST*... + (x (list* 1 2 3 4 5)) + ;; ...or pass them as literals via dot notation. + (y '(6 7 8 9 . 0))) + ;; The function LAST returns the last cons cell of a list. + (assert-equal ____ (last x)) + (assert-equal ____ (list y))) + ;; We can create a cyclic list by changing the last CDR of a list to refer to + ;; another cons cell + (let ((list (list 1 2 3 4 5)) + (cyclic-list (list 1 2 3 4 5))) + (setf (cdr (last cyclic-list)) cyclic-list) + ;; Function LIST-LENGTH returns NIL if a list is cyclic. + (assert-equal ____ (list-length list)) + (assert-equal ____ (list-length cyclic-list)) + ;; Many Lisp functions operate only on proper lists. + ;; The function NTH is not one of them; it can be used to retrieve elements + ;; of cyclic lists. + (assert-equal ____ (nth 101 cyclic-list)))) + +(define-test push-pop + ;; PUSH and POP are macros similar to SETF, as both of them operate on places. + (let ((place '(10 20 30 40))) + ;; PUSH sets the value of the place to a new cons cell containing some value + ;; in its CAR. + (push 0 place) + (assert-equal ____ place) + ;; POP removes a single cons cell from a place, sets the place to its CDR, + ;; and returns the value from its CAR. + (let ((value (pop place))) + (assert-equal ____ value) + (assert-equal ____ place)) + ;; The return value of POP can be discarded to simply "remove" a single cons + ;; cell from a place. + (pop place) + (let ((value (pop place))) + (assert-equal ____ value) + (assert-equal ____ place)))) + +(define-test append-nconc + ;; The functions APPEND and NCONC appends one list to the end of another. + ;; While APPEND creates new lists, NCONC modifies existing ones; therefore + ;; APPEND can be used on literals, but NCONC needs fresh lists. + (assert-equal ____ (append '(:a :b) '(:c))) + (assert-equal ____ (nconc (list :a :b) (list :c))) + (let ((list-1 (list 1 2 3)) + (list-2 (list 4 5 6))) + ;; Both APPEND and NCONC return the appended list, but the interesting part + ;; is what happens when we try to use the original variables passed to them. + (assert-equal ____ (append list-1 list-2)) + (assert-equal ____ list-1) + (assert-equal ____ list-2) + (assert-equal ____ (nconc list-1 list-2)) + (assert-equal ____ list-1) + (assert-equal ____ list-2))) (define-test test-accessing-list-elements - (let ((noms '("peanut" "butter" "and" "jelly"))) - (assert-equal "peanut" (first noms)) - (assert-equal ___ (second noms)) - (assert-equal ___ (fourth noms)) - "last returns a singleton list of the final element" - (assert-equal ___ (last noms)) - (assert-equal "butter" (nth 1 noms)) ; k 1 - (assert-equal ___ (nth 0 noms)) - (assert-equal ___ (nth 2 noms)) - "'elt' is similar to 'nth', with the arguments reversed" - (assert-equal ___ (elt noms 2)))) + (let ((noms '("peanut" "butter" "and" "jelly"))) + (assert-equal "peanut" (first noms)) + (assert-equal ___ (second noms)) + (assert-equal ___ (fourth noms)) + "last returns a singleton list of the final element" + (assert-equal ___ (last noms)) + (assert-equal "butter" (nth 1 noms)) ; k 1 + (assert-equal ___ (nth 0 noms)) + (assert-equal ___ (nth 2 noms)) + "'elt' is similar to 'nth', with the arguments reversed" + (assert-equal ___ (elt noms 2)))) (define-test test-slicing-lists - (let ((noms '("peanut" "butter" "and" "jelly"))) - (assert-equal ___ (subseq noms 0 1)) - (assert-equal ___ (subseq noms 0 2)) - (assert-equal ___ (subseq noms 2 2)) - (assert-equal ___ (subseq noms 2)))) + (let ((noms '("peanut" "butter" "and" "jelly"))) + (assert-equal ___ (subseq noms 0 1)) + (assert-equal ___ (subseq noms 0 2)) + (assert-equal ___ (subseq noms 2 2)) + (assert-equal ___ (subseq noms 2)))) (define-test test-list-breakdown - "car (aka. 'first') returns the first value in a list" + "car (aka. 'first') returns the first value in a list" (assert-equal ___ (car '(1 2 3))) (assert-equal ___ (car nil)) - "cdr (aka. 'rest') refers to the remainder of the list, + "cdr (aka. 'rest') refers to the remainder of the list, after the first element" (assert-equal ___ (cdr '(1 2 3))) (assert-equal ___ (cdr nil))) diff --git a/koans/nil-false-empty.lisp b/koans/nil-false-empty.lisp index ca06edf3..6d4dd412 100644 --- a/koans/nil-false-empty.lisp +++ b/koans/nil-false-empty.lisp @@ -1,55 +1,52 @@ -;; 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. - -(define-test test-t-and-nil-are-opposites - "not is a function which returns the boolean opposite of its argument" - (true-or-false? ___ (not nil)) - (true-or-false? ___ (not t))) - - -(define-test test-nil-and-empty-list-are-the-same-thing - (true-or-false? ___ ()) - (true-or-false? ___ (not ()))) - - -(define-test test-lots-of-things-are-true - " every value, other than nil, is boolean true" - (true-or-false? ___ 5) - (true-or-false? ___ (not 5)) - (true-or-false? ___ "A String") - "only nil is nil. Everything else is effectively true." - "the empty string" - (true-or-false? ___ "") - "a list containing a nil" - (true-or-false? ___ '(nil)) - "an array with no elements" - (true-or-false? ___ (make-array '(0))) - "the number zero" - (true-or-false? ___ 0)) - - -(define-test test-and - "and can take multiple arguments" - (true-or-false? ___ (and t t t t t)) - (true-or-false? ___ (and t t nil t t)) - "if no nils, and returns the last value" - (assert-equal ___ (and t t t t t 5))) - - -(define-test test-or - "or can also take multiple arguments" - (true-or-false? ____ (or nil nil nil t nil)) - "or returns the first non nil value, or nil if there are none." - (assert-equal ____ (or nil nil nil)) - (assert-equal ____ (or 1 2 3 4 5))) \ No newline at end of file +;;; 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. + +(define-test t-and-nil-are-opposites + ;; NOT is a function which returns the boolean opposite of its argument. + (true-or-false? ____ (not nil)) + (true-or-false? ____ (not t))) + +(define-test nil-and-empty-list-are-the-same-thing + ;; In Common Lisp, NIL is also the empty list. + (true-or-false? ____ '()) + (true-or-false? ____ (not '()))) + +(define-test in-lisp-many-things-are-true + ;; In Common Lisp, the canonical values for truth is T. + ;; However, everything that is non-NIL is true, too. + (true-or-false? ____ 5) + (true-or-false? ____ (not 5)) + (true-or-false? ____ "a string") + ;; Even an empty string... + (true-or-false? ____ "") + ;; ...or a list containing a NIL... + (true-or-false? ____ (list nil)) + ;; ...or an array with no elements... + (true-or-false? ____ (make-array 0)) + ;; ...or the number zero. + (true-or-false? ____ 0)) + +(define-test and + ;; The logical operator AND can take multiple arguments. + (true-or-false? ____ (and t t t t t)) + (true-or-false? ____ (and t t nil t t)) + ;; If all values passed to AND are true, it returns the last value. + (assert-equal ____ (and t t t t t 5))) + +(define-test or + ;; The logical operator OR can also take multiple arguments. + (true-or-false? ____ (or nil nil nil t nil)) + ;; OR returns the first non-NIL value it encounters, or NIL if there are none. + (assert-equal ____ (or nil nil nil)) + (assert-equal ____ (or 1 2 3 4 5))) diff --git a/koans/special-forms.lisp b/koans/special-forms.lisp deleted file mode 100644 index e9959fed..00000000 --- a/koans/special-forms.lisp +++ /dev/null @@ -1,147 +0,0 @@ -;; 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. - - -; Special forms are evaluatable lisp forms (lists) which are -; neither functions nor macros. Here is an introduction to a -; few of them. - -; based on http://psg.com/~dlamkins/sl/chapter03-03.html - -(defvar my-name) -(defvar my-clones-name) -(defvar a) -(defvar b) -(defvar c 0) - -(define-test test-setf - "setf is used to assign values to symbols. These symbols may refer to - variables with lexical or dynamic scope." - (setf my-name "David") - (assert-equal my-name ____) - " In SBCL, if the symbol isn't defined as a variable, via a top-level defvar - or let statement, the setf call may result in a warning." - (setf my-clones-name my-name) - (assert-equal "David" ____) - (setf a 5) - (setf b 10) - (setf c ___) - (assert-equal 50 c)) - - -(define-test test-let - "The let form establishes a lexical extent, within which explicit symbols - may be bound to values. The binding only extends over the extent of the - lexical form. After which, the previous value, if it exists, is visible again." - (setf a 10) - (setf b 20) - (assert-equal a ___) - (assert-equal b ___) - (let ((a 1111) - (b 2222)) - (assert-equal a ___) - (assert-equal b ___)) - (assert-equal a ___) - (assert-equal b ___)) - - -(define-test test-let-default-value - "let vars have a default value" - (let ((x)) - (assert-equal ___ x))) - -(define-test test-let-bindings-are-parallel - "When defining the bindings in the let form, later bindings may not depend - on earlier ones" - (setf a 100) - (let ((a 5) - (b (* 10 a))) - (assert-equal b ___))) - -(define-test test-let*-bindings-are-series - "let* is like let, but successive bindings may use values of previous ones" - (setf a 100) - (let* ((a 5) - (b (* 10 a))) - (assert-equal b ___)) - (assert-equal a ___)) - - -(define-test write-your-own-let-statement - "fix the let statement to get the tests to pass" - (setf a 100) - (setf b 23) - (setf c 456) - (let ((a __) - (b __) - (c __)) - (assert-equal a 100) - (assert-equal b 200) - (assert-equal c "Jellyfish")) - (let* ((a __) - ;; add more here - ) - (assert-equal a 121) - (assert-equal b 200) - (assert-equal c (+ a (/ b a))))) - -(define-test test-case - "the case form is like the C switch statement: it - compares an input with a set of values and evaluates an - expression once a match is found" - (setf a 4) - (setf b - (case a (4 :four) - (5 :five) - ;; t specifies default behavior - (t :unknown))) - (assert-equal ____ b) - "case can also check if a list of values contains - the input" - (setf c - (case a (5 :five) - ((3 4) :three-or-four))) - (assert-equal ____ c)) - -(defun cartoon-dads (input) - "you should be able to complete this case statement" - (case input (:this-one-doesnt-happen :fancy-cat) - (t :unknown))) - -(define-test test-your-own-case-statement - "fix this by completing the 'cartoon-dads' function above" - (assert-equal (cartoon-dads :bart) :homer) - (assert-equal (cartoon-dads :stewie) :peter) - (assert-equal (cartoon-dads :stan) :randy) - (assert-equal (cartoon-dads :space-ghost) :unknown)) - -(define-test test-limits-of-case - "case is not suitable for all kinds of values, because - it uses the function eql for comparisons. We will explore - the implications of this in the equality-distinctions lesson" - (let* ((name "John") - (lastname (case name ("John" "Doe") - ("Max" "Mustermann") - (t "Anonymous")))) - (assert-equal ____ lastname))) - -(define-test test-cond - "cond is the general purpose form for checking multiple - conditions, until a condition is met" - (setf a 4) - (setf c - (cond ((> a 0) :positive) - ((< a 0) :negative) - (t :zero))) - (assert-equal ____ c)) diff --git a/test-framework.lisp b/test-framework.lisp index c9d30900..20137153 100644 --- a/test-framework.lisp +++ b/test-framework.lisp @@ -122,31 +122,31 @@ ;;; Assert macros -(defmacro assert-eq (expected form) +(defmacro assert-eq (form expected) "Assert whether expected and form are EQ." `(expand-assert :equal ,form ,form ,expected :test #'eq)) -(defmacro assert-eql (expected form) +(defmacro assert-eql (form expected) "Assert whether expected and form are EQL." `(expand-assert :equal ,form ,form ,expected :test #'eql)) -(defmacro assert-equal (expected form) +(defmacro assert-equal (form expected) "Assert whether expected and form are EQUAL." `(expand-assert :equal ,form ,form ,expected :test #'equal)) -(defmacro assert-equalp (expected form) +(defmacro assert-equalp (form expected) "Assert whether expected and form are EQUALP." `(expand-assert :equal ,form ,form ,expected :test #'equalp)) -(defmacro true-or-false? (expected form) +(defmacro true-or-false? (form expected) "Assert whether expected and form are logically equivalent." - `(expand-assert :equal ,form (not (not ,form)) ,expected :test #'equal)) + `(expand-assert :equal ,form (notnot ,form) ,(notnot expected) :test #'eql)) -(defmacro assert-error (condition form) +(defmacro assert-error (form condition) "Assert whether form signals condition." `(expand-assert :error ,form (handler-case ,form (error (e) e)) ,condition)) -(defmacro assert-expands (expansion form) +(defmacro assert-expands (form expansion) "Assert whether form expands to expansion." `(expand-assert :macro ,form (macroexpand-1 ',form) ,expansion)) @@ -156,7 +156,7 @@ (defmacro assert-true (form) "Assert whether the form is true." - `(expand-assert :result ,form ,form t :test #'notnot)) + `(expand-assert :result ,form ,(notnot form) t)) ;;; Run the tests From 8ad95e73ac4733ac315eef46b96380bcb7215b58 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Wed, 6 May 2020 18:19:19 +0200 Subject: [PATCH 078/133] More betterified koans --- koans/arrays.lisp | 51 +++---- koans/basic-macros.lisp | 27 ++-- koans/equality-distinctions.lisp | 201 +++++++++++++++------------ koans/hash-tables.lisp | 227 ++++++++++++++----------------- koans/lists.lisp | 86 ++++++------ koans/multiple-values.lisp | 77 +++++------ koans/vectors.lisp | 81 +++++------ 7 files changed, 371 insertions(+), 379 deletions(-) diff --git a/koans/arrays.lisp b/koans/arrays.lisp index c00c17fa..7b2912e3 100644 --- a/koans/arrays.lisp +++ b/koans/arrays.lisp @@ -14,28 +14,29 @@ ;;; See http://www.gigamonkeys.com/book/collections.html -(define-test test-basic-array-stuff - "We define an 8x8 array and then fill it with a checkerboard pattern." +(define-test basic-array-stuff + ;; We make an 8x8 array and then fill it with a checkerboard pattern. (let ((chess-board (make-array '(8 8)))) - "(DOTIMES (X 8) ...) will iterate with X taking values from 0 to 7." + ;; (DOTIMES (X 8) ...) will iterate with X taking values from 0 to 7. (dotimes (x 8) (dotimes (y 8) - "AREF stands for \"array reference\"." + ;; AREF stands for "array reference". (setf (aref chess-board x y) (if (evenp (+ x y)) :black :white)))) (assert-true (typep chess-board 'array)) - (assert-equal (aref chess-board 0 0) ____) - (assert-equal (aref chess-board 2 3) ____) - "ARRAY-RANK returns the number of dimensions of the array." + (assert-equal ____ (aref chess-board 0 0)) + (assert-equal ____ (aref chess-board 2 3)) + ;; The function ARRAY-RANK returns the number of dimensions of the array. (assert-equal ____ (array-rank chess-board)) - "ARRAY-DIMENSIONS returns a list of the cardinality of the array dims" + ;; The function ARRAY-DIMENSIONS returns a list of the cardinality of the + ;; array dimensions. (assert-equal ____ (array-dimensions chess-board)) - "ARRAY-TOTAL-SIZE returns the total number of elements in the array." + ;; ARRAY-TOTAL-SIZE returns the total number of elements in the array. (assert-equal ____ (array-total-size chess-board)))) -(define-test test-make-your-own-array - "Make your own array that meets the specifications below." +(define-test make-your-own-array + ;; Make your own array that satisfies the test. (let ((color-cube ____)) - "You may need to modify your array after you create it." + ;; You may need to modify your array after you create it. (setf (____ color-cube ____ ____ ____) ____ (____ color-cube ____ ____ ____) ____) (if (typep color-cube '(simple-array T (3 3 3))) @@ -47,25 +48,25 @@ (assert-equal (aref color-cube 2 1 0) :white)) (assert-true nil)))) -(define-test test-adjustable-array - "The size of an array does not need to be constant." +(define-test adjustable-array + ;; The size of an array does not need to be constant. (let ((x (make-array '(2 2) :initial-element 5 :adjustable t))) - (assert-equal (aref x 1 0) ____) - (assert-equal (array-dimensions x) ____) + (assert-equal ____ (aref x 1 0)) + (assert-equal ____ (array-dimensions x)) (adjust-array x '(3 4)) - (assert-equal (array-dimensions x) ____))) + (assert-equal ____ (array-dimensions x)))) -(define-test test-make-array-from-list - "One can create arrays from list structure." +(define-test make-array-from-list + ;; One can create arrays with initial contents. (let ((x (make-array '(4) :initial-contents '(:one :two :three :four)))) - (assert-equal (array-dimensions x) ____) + (assert-equal ____ (array-dimensions x)) (assert-equal ____ (aref x 0)))) -(define-test test-row-major-index - "Row major indexing is a way to access elements with a single integer, - rather than a list of integers." +(define-test row-major-index + ;; Row major indexing is a way to access elements with a single integer, + ;; rather than a list of integers. (let ((my-array (make-array '(2 2 2 2)))) (dotimes (i (* 2 2 2 2)) (setf (row-major-aref my-array i) i)) - (assert-equal (aref my-array 0 0 0 0) ____) - (assert-equal (aref my-array 1 1 1 1) ____))) + (assert-equal ____ (aref my-array 0 0 0 0)) + (assert-equal ____ (aref my-array 1 1 1 1)))) diff --git a/koans/basic-macros.lisp b/koans/basic-macros.lisp index dc1d8dd0..28412c7f 100644 --- a/koans/basic-macros.lisp +++ b/koans/basic-macros.lisp @@ -66,21 +66,20 @@ (assert-equal :found-a-nil (case-special-symbols-match nil)) (assert-equal :something-else (case-special-symbols-match 42))) -(defun cartoon-dads (input) - (case input - ;; Fill in the blanks with proper cases. - ____ - ____ - ____ - (:this-one-doesnt-happen :fancy-cat) - (t :unknown))) - (define-test your-own-case-statement - ;; You need to fill in the blanks in CARTOON-DADS. - (assert-equal (cartoon-dads :bart) :homer) - (assert-equal (cartoon-dads :stewie) :peter) - (assert-equal (cartoon-dads :stan) :randy) - (assert-equal (cartoon-dads :space-ghost) :unknown)) + ;; We use FLET to define a local function. + (flet ((cartoon-dads (input) + (case input + ;; Fill in the blanks with proper cases. + ____ + ____ + ____ + (:this-one-doesnt-happen :fancy-cat) + (t :unknown)))) + (assert-equal (cartoon-dads :bart) :homer) + (assert-equal (cartoon-dads :stewie) :peter) + (assert-equal (cartoon-dads :stan) :randy) + (assert-equal (cartoon-dads :space-ghost) :unknown))) (define-test limits-of-case ;; So far, we have been comparing objects using EQUAL, one of the Lisp diff --git a/koans/equality-distinctions.lisp b/koans/equality-distinctions.lisp index 50e0b55a..4bfb72af 100644 --- a/koans/equality-distinctions.lisp +++ b/koans/equality-distinctions.lisp @@ -1,92 +1,121 @@ -;; 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. +;;; 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. -;; the most common equality predicates are eq, eql, equal and equalp -;; eq is similar to comparing c pointers -(define-test test-eq - "(eq x y) is true if and only if x and y are the same identical object - eq is like comparing pointers in c. If the values are EQ, any non-nil - value may be returned." - (true-or-false? ___ (eq 'a 'a)) - (true-or-false? ___ (eq 3 3.0)) - (true-or-false? ___ (eq '(1 2) '(1 2))) - (true-or-false? ___ (eq "Foo" "Foo")) - (true-or-false? ___ (eq "Foo" (copy-seq "Foo"))) - (true-or-false? ___ (eq "FOO" "Foo"))) +;;; The most common equality predicates in Common Lisp are, in order of +;;; strictness, EQ, EQL, EQUAL, and EQUALP. -(define-test test-eql - "(eql x y) is true if (eq x y) - also it is true if x and y are numeric of the same type - and represent the same number. - (eql x y) also if x and y are the same characters." - (true-or-false? ___ (eql 'a 'a)) - (true-or-false? ___ (eql 3 3)) - (true-or-false? ___ (eql 3 3.0)) - (true-or-false? ___ (eql '(1 2) '(1 2))) - (true-or-false? ___ (eql '(:a . :b) '(:a . :b))) - (true-or-false? ___ (eql #\S #\S)) - (true-or-false? ___ (eql "Foo" "Foo")) - (true-or-false? ___ (eql "Foo" (copy-seq "Foo"))) - (true-or-false? ___ (eql "FOO" "Foo"))) +(define-test eq + ;; EQ checks the identity of the two objects; it checks whether the two + ;; objects are, in fact, one and the same object. + ;; It is the fastest of the four; however, not guaranteed to work on numbers + ;; and characters because of that. + (true-or-false? ____ (eq 'a 'a)) + (true-or-false? ____ (eq 3 3.0)) + (true-or-false? ____ (eq '(1 2) '(1 2))) + (true-or-false? ____ (eq "Foo" "Foo")) + (true-or-false? ____ (eq "Foo" (copy-seq "Foo"))) + (true-or-false? ____ (eq "FOO" "Foo"))) -(define-test test-equal - "(equal x y) is true if (eql x y), or - x and y are lists with equal elements, or - x and y character or bit arrays with equal elements" - (true-or-false? ___ (equal 'a 'a)) - (true-or-false? ___ (equal 3 3)) - (true-or-false? ___ (equal 3 3.0)) - (true-or-false? ___ (equal '(1 2) '(1 2))) - (true-or-false? ___ (equal '(:a . :b) '(:a . :b))) - (true-or-false? ___ (equal '(:a . :b) '(:a . :doesnt-match))) - (true-or-false? ___ (equal #\S #\S)) - (true-or-false? ___ (equal "Foo" "Foo")) - (true-or-false? ___ (equal "Foo" (copy-seq "Foo"))) - (true-or-false? ___ (equal "FOO" "Foo"))) +(define-test eql + ;; EQL works like EQ, except it is specified to work for numbers and + ;; characters. + ;; Two numbers are EQL if they are of the same type and represent the same + ;; number. Two characters are EQL if they represent the same character. + (true-or-false? ____ (eql 'a 'a)) + (true-or-false? ____ (eql 3 3)) + (true-or-false? ____ (eql 3 3.0)) + (true-or-false? ____ (eql '(1 2) '(1 2))) + (true-or-false? ____ (eql '(:a . :b) '(:a . :b))) + (true-or-false? ____ (eql #\S #\S)) + (true-or-false? ____ (eql "Foo" "Foo")) + (true-or-false? ____ (eql "Foo" (copy-seq "Foo"))) + (true-or-false? ____ (eql "FOO" "Foo"))) -(define-test test-equalp - "(equalp x y) if (equal x y) or - if x and y are strings with the same characters (case independent). - if x and y are arrays with the same dimensions and equal elements - if x and y are numeric of different types but one may be upgraded to - the other type without loss and still exhibit equality." - (true-or-false? ___ (equalp 'a 'a)) - (true-or-false? ___ (equalp 3 3)) - (true-or-false? ___ (equalp 3 3.0)) - (true-or-false? ___ (equalp '(1 2) '(1 2))) - (true-or-false? ___ (equalp '(:a . :b) '(:a . :b))) - (true-or-false? ___ (equalp '(:a . :b) '(:a . :doesnt-match))) - (true-or-false? ___ (equalp #\S #\S)) - (true-or-false? ___ (equalp "Foo" "Foo")) - (true-or-false? ___ (equalp "Foo" (copy-seq "Foo"))) - (true-or-false? ___ (equalp "FOO" "Foo"))) +(define-test equal + ;; EQUAL works like EQL, except works differently for lists, strings, bit + ;; vectors, and pathnames. + ;; Two lists, strings, bit arrays, or pathnames are EQUAL if they have EQUAL + ;; elements. + (true-or-false? ____ (equal 'a 'a)) + (true-or-false? ____ (equal 3 3)) + (true-or-false? ____ (equal 3 3.0)) + (true-or-false? ____ (equal '(1 2) '(1 2))) + (true-or-false? ____ (equal '(:a . :b) '(:a . :b))) + (true-or-false? ____ (equal '(:a . :b) '(:a . :doesnt-match))) + (true-or-false? ____ (equal #\S #\S)) + (true-or-false? ____ (equal "Foo" "Foo")) + (true-or-false? ____ (equal #*01010101 #*01010101)) + (true-or-false? ____ (equal "Foo" (copy-seq "Foo"))) + (true-or-false? ____ (equal "FOO" "Foo")) + (true-or-false? ____ (equal #p"foo/bar/baz" #p"foo/bar/baz"))) -(define-test test-numeric-equal - "(= x y) is only for numerics - and can take multiple arguments - if x or y is not numeric there will be a compiler error." - (true-or-false? ___ (= 99.0 99 99.000)) - (true-or-false? ___ (= 0 1 -1)) - (true-or-false? ___ (= (/ 2 3) (/ 6 9) (/ 86 129)))) +(defstruct thing slot-1 slot-2) -; EQ, EQL, EQUAL, and EQUALP are general equality predicates. -; Additionally, Lisp also provides the type-specific predicates. -; For example, STRING= and STRING-EQUAL are predicates for strings. -(define-test test-string-equal - "string-equal is just like string= except that differences in case are ignored." - (true-or-false? ___ (string= "Foo" "Foo")) - (true-or-false? ___ (string= "Foo" "FOO")) - (true-or-false? ___ (string= "together" "frog" :start1 1 :end1 3 :start2 2)) - (true-or-false? ___ (string-equal "Foo" "FOO")) - (true-or-false? ___ (string-equal "together" "FROG" :start1 1 :end1 3 :start2 2))) +(define-test equalp + ;; EQUALP works like EQUAL, except it works differently for characters, + ;; numbers, arrays, structures, and hash tables. + ;; Two characters are EQUALP if they represent the same character, ignoring + ;; the differences in character case. + ;; Two numbers are EQUALP if they represent the same number, even if they are + ;; of different types. + ;; Two arrays are EQUALP if they have the same dimensions and their characters + ;; are pairwise EQUALP. + ;; Two structures are EQUALP if they are of the same class and their slots are + ;; pairwise EQUALP. + ;; We will contemplate hash tables in the HASH-TABLES lesson. + (true-or-false? ____ (equalp 'a 'a)) + (true-or-false? ____ (equalp 3 3)) + (true-or-false? ____ (equalp 3 3.0)) + (true-or-false? ____ (equalp '(1 2) '(1 2))) + (true-or-false? ____ (equalp '(:a . :b) '(:a . :b))) + (true-or-false? ____ (equalp '(:a . :b) '(:a . :doesnt-match))) + (true-or-false? ____ (equalp #\S #\S)) + (true-or-false? ____ (equalp "Foo" "Foo")) + (true-or-false? ____ (equalp "Foo" (copy-seq "Foo"))) + (true-or-false? ____ (equalp "FOO" "Foo")) + (true-or-false? ____ (equalp (make-array '(4 2) :initial-element 0) + (make-array '(4 2) :initial-element 0))) + (true-or-false? ____ (equalp (make-thing :slot-1 42 :slot-2 :forty-two) + (make-thing :slot-1 42 :slot-2 :forty-two)))) + +;;; In additional to the generic equality predicates, Lisp also provides +;;; type-specific predicates for numbers, strings, and characters. + +(define-test = + ;; The function = behaves just like EQUALP on numbers. + ;; #C(... ...) is syntax sugar for creating a complex number. + (true-or-false? ____ (= 99.0 99 99.000 #C(99 0) #C(99.0 0.0))) + (true-or-false? ____ (= 0 1 -1)) + (true-or-false? ____ (= (/ 2 3) (/ 6 9) (/ 86 129)))) + +(define-test string= + ;; The function STRING= behaves just like EQUAL on strings. + ;; The function STRING-EQUAL behaves just like EQUALP on strings. + (true-or-false? ____ (string= "Foo" "Foo")) + (true-or-false? ____ (string= "Foo" "FOO")) + (true-or-false? ____ (string-equal "Foo" "FOO")) + ;; These functions accept additional keyword arguments that allow one to + ;; only compare parts of the strings. + (true-or-false? ____ (string= "together" "frog" :start1 1 :end1 3 + :start2 2)) + (true-or-false? ____ (string-equal "together" "FROG" :start1 1 :end1 3 + :start2 2))) + +(define-test char= + ;; The function CHAR= behaves just like EQL on characters. + ;; The function CHAR-EQUAL behaves just like EQUALP on characters. + (true-or-false? ____ (char= #\A (char "ABCDEF" 0))) + (true-or-false? ____ (char= #\A #\a)) + (true-or-false? ____ (char-equal #\A (char "ABCDEF" 0))) + (true-or-false? ____ (char-equal #\A #\a))) diff --git a/koans/hash-tables.lisp b/koans/hash-tables.lisp index 17ed0b90..485d4092 100644 --- a/koans/hash-tables.lisp +++ b/koans/hash-tables.lisp @@ -1,128 +1,105 @@ -;; 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. - - -; based on python koans: about_dictionaries.py - - -(define-test test-create-hash-table - "make hash table with make-hash-table" - (let ((my-hash-table)) - (setf my-hash-table (make-hash-table)) - (true-or-false? ___ (typep my-hash-table 'hash-table)) - (true-or-false? ___ (hash-table-p my-hash-table)) - (true-or-false? ___ (hash-table-p (make-array '(3 3 3)))) - (assert-equal ___ (hash-table-count my-hash-table)))) - - -(define-test test-hash-table-access - "gethash is for accessing hash tables" - (let ((table-of-cube-roots (make-hash-table))) - - "assign the key-value pair 1->'uno'" - (setf (gethash 1 table-of-cube-roots) "uno") - (assert-equal "uno" (gethash 1 table-of-cube-roots)) - (assert-equal 1 (hash-table-count table-of-cube-roots)) - - (setf (gethash 8 table-of-cube-roots) 2) - (setf (gethash -3 table-of-cube-roots) -27) - (assert-equal ___ (gethash -3 table-of-cube-roots)) - (assert-equal ___ (hash-table-count table-of-cube-roots)) - - "accessing unset keys returns nil" - (assert-equal ___ (gethash 125 table-of-cube-roots)))) - - -(define-test test-hash-key-equality - "hash tables need to know how to tell if two keys are equivalent. - The programmer must be careful to know which equality predicate is right." - (let ((hash-table-eq nil) - (hash-table-equal nil) - (hash-table-default nil)) - - "define three hash tables, with different equality tests" - (setf hash-table-eq (make-hash-table :test #'eq)) - (setf hash-table-equal (make-hash-table :test #'equal)) - (setf hash-table-default (make-hash-table)) - - "add the same string twice, to each" - (setf (gethash "one" hash-table-eq) "uno") - (setf (gethash "one" hash-table-eq) "uno") - - (setf (gethash "one" hash-table-equal) "uno") - (setf (gethash "one" hash-table-equal) "uno") - - (setf (gethash "one" hash-table-default) "uno") - (setf (gethash "one" hash-table-default) "uno") - - "count how many unique key-value pairs in each" - (assert-equal ___ (hash-table-count hash-table-eq)) - (assert-equal ___ (hash-table-count hash-table-equal)) - (assert-equal ___ (hash-table-count hash-table-default)))) - - -(define-test test-hash-table-equality - (let ((h1 (make-hash-table :test #'equal)) - (h2 (make-hash-table :test #'equal))) - (setf (gethash "one" h1) "yat") - (setf (gethash "one" h2) "yat") - (setf (gethash "two" h1) "yi") - (setf (gethash "two" h2) "yi") - (true-or-false? ___ (eq h1 h2)) - (true-or-false? ___ (equal h1 h2)) - (true-or-false? ___ (equalp h1 h2)))) - - -(define-test test-changing-hash-tables - (let ((babel-fish (make-hash-table :test #'equal)) - (expected (make-hash-table :test #'equal))) - (setf (gethash "one" babel-fish) "uno") - (setf (gethash "two" babel-fish) "dos") - (setf (gethash "one" expected) "eins") - (setf (gethash "two" expected) "zwei") - - (setf (gethash "one" babel-fish) "eins") - (setf (gethash "two" babel-fish) ____) - - (assert-true (equalp babel-fish expected)))) - - -(define-test test-hash-key-membership - "hash tables use multiple value return to tell you if the key exists" - (let ((prev-pres (make-hash-table :test #'equal)) - (value-and-exists nil)) - (setf (gethash "Obama" prev-pres) "Bush") - (setf (gethash "Lincoln" prev-pres) "Buchanan") - (setf (gethash "Washington" prev-pres) nil) - - (setf value-and-exists (multiple-value-list (gethash "Obama" prev-pres))) - (assert-equal value-and-exists '("Bush" t)) - (setf value-and-exists (multiple-value-list (gethash "Lincoln" prev-pres))) - (assert-equal value-and-exists ____) - (setf value-and-exists (multiple-value-list (gethash "Washington" prev-pres))) - (assert-equal value-and-exists ____) - (setf value-and-exists (multiple-value-list (gethash "Franklin" prev-pres))) - (assert-equal value-and-exists ____))) - +;;; 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. + +;;; A hash table data structure is sometimes known as a dictionary. + +(define-test make-hash-table + (let ((my-hash-table (make-hash-table))) + (true-or-false? ____ (typep my-hash-table 'hash-table)) + (true-or-false? ____ (hash-table-p my-hash-table)) + (true-or-false? ____ (hash-table-p (make-array '(3 3 3)))) + ;; The function HASH-TABLE-COUNT returns the number of entries currently + ;; contained in a hash table. + (assert-equal ____ (hash-table-count my-hash-table)))) + +(define-test gethash + ;; The function GETHASH can be used to access hash table values. + (let ((cube-roots (make-hash-table))) + ;; We add the key-value pair 1 - "uno" to the hash table. + (setf (gethash 1 cube-roots) "uno") + (assert-equal ____ (gethash 1 cube-roots)) + (assert-equal ____ (hash-table-count cube-roots)) + (setf (gethash 8 cube-roots) 2) + (setf (gethash -3 cube-roots) -27) + (assert-equal ____ (gethash -3 cube-roots)) + (assert-equal ____ (hash-table-count cube-roots)) + ;; GETHASH returns a secondary value that is true if the key was found in + ;; the hash-table and false otherwise. + (multiple-value-bind (value foundp) (gethash 8 cube-roots) + (assert-equal ____ value) + (assert-equal ____ foundp)) + (multiple-value-bind (value foundp) (gethash 125 cube-roots) + (assert-equal ____ value) + (assert-equal ____ foundp)))) + +(define-test hash-table-test + ;; A hash table can be constructed with different test predicates. + ;; The programmer may choose between EQ, EQL, EQUAL, and EQUALP to get the + ;; best performance and expected results from the hash table. + ;; The default test predicate is EQL. + (let ((eq-table (make-hash-table :test #'eq)) + (eql-table (make-hash-table)) + (equal-table (make-hash-table :test #'equal)) + (equalp-table (make-hash-table :test #'equalp))) + ;; We will define four variables whose values are strings. + (let ((string "one") + (same-string string) + (string-copy (copy-string string)) + (string-upcased "ONE"))) + ;; We will insert the value of each variable into each hash table. + (dolist (thing (list string same-string string-copy string-upcased)) + (dolist (hash-table (list eq-table eql-table equal-table equalp-table)) + (setf (gethash string hash-table) t))) + ;; How many entries does each hash table contain? + (assert-equal ____ (hash-table-count eq-table)) + (assert-equal ____ (hash-table-count eql-table)) + (assert-equal ____ (hash-table-count equal-table)) + (assert-equal ____ (hash-table-count equalp-table)))) + +(define-test hash-table-equality + ;; EQUALP considers two hash tables to be equal if they have the same test and + ;; if its key-value pairs are the same under that test. + (let ((hash-table-1 (make-hash-table :test #'equal)) + (hash-table-2 (make-hash-table :test #'equal))) + (setf (gethash "one" hash-table-1) "yat") + (setf (gethash "one" hash-table-2) "yat") + (setf (gethash "two" hash-table-1) "yi") + (setf (gethash "two" hash-table-2) "yi") + (true-or-false? ____ (eq hash-table-1 hash-table-2)) + (true-or-false? ____ (equal hash-table-1 hash-table-2)) + (true-or-false? ____ (equalp hash-table-1 hash-table-2)))) + +(define-test i-will-make-it-equalp + (let ((hash-table-1 (make-hash-table :test #'equal)) + (hash-table-2 (make-hash-table :test #'equal))) + (setf (gethash "one" hash-table-1) "uno" + (gethash "two" hash-table-1) "dos") + (setf (gethash "one" hash-table-2) "eins" + (gethash "two" hash-table-2) "zwei") + (assert-false (equalp hash-table-1 hash-table-2)) + ;; Change the first hash table to be EQUALP to the second one. + (setf (gethash ____ hash-table-1) ____ + (gethash ____ hash-table-1) ____) + (assert-true (equalp hash-table-1 hash-table-2)))) (define-test test-make-your-own-hash-table - "make a hash table that meets the following conditions" - (let ((colors (make-hash-table)) - values) - + ;; Make your own hash table that satisfies the test. + (let ((colors ____)) + ;; You will need to modify your hash table after you create it. + ____ (assert-equal (hash-table-count colors) 4) - (setf values (list (gethash "blue" colors) - (gethash "green" colors) - (gethash "red" colors))) - (assert-equal values '((0 0 1) (0 1 0) (1 0 0))))) + (let ((values (list (gethash "blue" colors) + (gethash "green" colors) + (gethash "red" colors)))) + (assert-equal values '((0 0 1) (0 1 0) (1 0 0)))))) diff --git a/koans/lists.lisp b/koans/lists.lisp index 5cdc4e69..bc1d8d96 100644 --- a/koans/lists.lisp +++ b/koans/lists.lisp @@ -64,30 +64,6 @@ (assert-equal ____ (cadr x)) (assert-equal ____ (cdaadr x)))) -(define-test cons-tructing-improper-lists - ;; A proper list is a list whose final CDR ends with NIL. - ;; An improper list either has a non-NIL value in its final CDR or does not - ;; have a final CDR due to a cycle in its structure. - (let (;; We can construct non-cyclic improper lists using LIST*... - (x (list* 1 2 3 4 5)) - ;; ...or pass them as literals via dot notation. - (y '(6 7 8 9 . 0))) - ;; The function LAST returns the last cons cell of a list. - (assert-equal ____ (last x)) - (assert-equal ____ (list y))) - ;; We can create a cyclic list by changing the last CDR of a list to refer to - ;; another cons cell - (let ((list (list 1 2 3 4 5)) - (cyclic-list (list 1 2 3 4 5))) - (setf (cdr (last cyclic-list)) cyclic-list) - ;; Function LIST-LENGTH returns NIL if a list is cyclic. - (assert-equal ____ (list-length list)) - (assert-equal ____ (list-length cyclic-list)) - ;; Many Lisp functions operate only on proper lists. - ;; The function NTH is not one of them; it can be used to retrieve elements - ;; of cyclic lists. - (assert-equal ____ (nth 101 cyclic-list)))) - (define-test push-pop ;; PUSH and POP are macros similar to SETF, as both of them operate on places. (let ((place '(10 20 30 40))) @@ -126,31 +102,45 @@ (define-test test-accessing-list-elements (let ((noms '("peanut" "butter" "and" "jelly"))) + ;; Common Lisp defines accessor functions for lists: FIRST, SECOND, ..., + ;; up to TENTH. (assert-equal "peanut" (first noms)) - (assert-equal ___ (second noms)) - (assert-equal ___ (fourth noms)) - "last returns a singleton list of the final element" - (assert-equal ___ (last noms)) - (assert-equal "butter" (nth 1 noms)) ; k 1 - (assert-equal ___ (nth 0 noms)) - (assert-equal ___ (nth 2 noms)) - "'elt' is similar to 'nth', with the arguments reversed" - (assert-equal ___ (elt noms 2)))) + (assert-equal ____ (second noms)) + (assert-equal ____ (fourth noms)) + ;; The function LAST returns the last cons cell of a list. + (assert-equal ____ (last noms)) + ;; The function NTH returns the n-th element of a list. + (assert-equal "butter" (nth 1 noms)) + (assert-equal ____ (nth 0 noms)) + (assert-equal ____ (nth 3 noms)))) +(define-test cons-tructing-improper-lists + ;; A proper list is a list whose final CDR ends with NIL. + ;; An improper list either has a non-NIL value in its final CDR or does not + ;; have a final CDR due to a cycle in its structure. + (let (;; We can construct non-cyclic improper lists using LIST*... + (x (list* 1 2 3 4 5)) + ;; ...or pass them as literals via dot notation. + (y '(6 7 8 9 . 0))) + (assert-equal ____ (last x)) + (assert-equal ____ (list y))) + ;; We can create a cyclic list by changing the last CDR of a list to refer to + ;; another cons cell + (let ((list (list 1 2 3 4 5)) + (cyclic-list (list 1 2 3 4 5))) + (setf (cdr (last cyclic-list)) cyclic-list) + ;; Function LIST-LENGTH returns NIL if a list is cyclic. + (assert-equal ____ (list-length list)) + (assert-equal ____ (list-length cyclic-list)) + ;; Many Lisp functions operate only on proper lists. + ;; The function NTH is not one of them; it can be used to retrieve elements + ;; of cyclic lists. + (assert-equal ____ (nth 101 cyclic-list)))) (define-test test-slicing-lists - (let ((noms '("peanut" "butter" "and" "jelly"))) - (assert-equal ___ (subseq noms 0 1)) - (assert-equal ___ (subseq noms 0 2)) - (assert-equal ___ (subseq noms 2 2)) - (assert-equal ___ (subseq noms 2)))) - - -(define-test test-list-breakdown - "car (aka. 'first') returns the first value in a list" - (assert-equal ___ (car '(1 2 3))) - (assert-equal ___ (car nil)) - "cdr (aka. 'rest') refers to the remainder of the list, - after the first element" - (assert-equal ___ (cdr '(1 2 3))) - (assert-equal ___ (cdr nil))) + ;; The function SUBSEQ returns a subsequence of a list. + (let ((noms (list "peanut" "butter" "and" "jelly"))) + (assert-equal ____ (subseq noms 0 1)) + (assert-equal ____ (subseq noms 0 2)) + (assert-equal ____ (subseq noms 2 2)) + (assert-equal ____ (subseq noms 2)))) diff --git a/koans/multiple-values.lisp b/koans/multiple-values.lisp index fafbfbff..b98014e9 100644 --- a/koans/multiple-values.lisp +++ b/koans/multiple-values.lisp @@ -1,48 +1,41 @@ -;; 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. +;;; 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. +;;; In Lisp, it is possible for a function to return more than one value. +;;; This is distinct from returning a list or structure of values. - -"In lisp, it is possible for a function to return more than one value. -This is distinct from returning a list or structure of values." - -(define-test test-floor-returns-multiple-values - (let ((x) - (y)) - (setf x (floor 1.5)) - (assert-equal x 1) - (setf x (multiple-value-list (floor 3/2))) - (assert-equal x '(1 1/2))) - (assert-equal (multiple-value-list (floor 99/4)) ____)) +(define-test multiple-values + (let ((x (floor 3/2)) + ;; The macro MULTIPLE-VALUE-LIST returns a list of all values returned + ;; by a Lisp form. + (y (multiple-value-list (floor 3/2)))) + (assert-equal x 1) + (assert-equal y '(1 1/2))) + (assert-equal ____ (multiple-value-list (floor 99/4)))) (defun next-fib (a b) + ;; The function VALUES allows returning multiple values. (values b (+ a b))) -(define-test test-multi-value-bind - (let ((x) - (y)) - (setf x (next-fib 2 3)) - (assert-equal x ___) - (setf x (multiple-value-list (next-fib 2 3))) - (assert-equal x ___) - "multiple-value-bind binds the variables in the first form - to the outputs of the second form. And then returns the output - of the third form using those bindings" - (setf y (multiple-value-bind (b c) (next-fib 3 5) (* b c))) - (assert-equal y ___) - "multiple-value-setq is like setf, but can set multiple variables" - (multiple-value-setq (x y) (values :v1 :v2)) - (assert-equal (list x y) '(:v1 :v2)) - (multiple-value-setq (x y) (next-fib 5 8)) - (assert-equal (list x y) ____))) +(define-test binding-and-setting-multiple-values + ;; The macro MULTIPLE-VALUE-BIND is like LET, except it binds the variables + ;; listed in its first argument to the values returned by the form in its + ;; second argument. + (multiple-value-bind (x y) (next-fib 3 5) + (let ((result (* x y))) + (assert-equal ____ result))) + ;; SETF can also set multiple values if a VALUES form is provided as a place. + (let (x y) + (setf (values x y) (next-fib 5 8)) + (assert-equal ____ (list x y)))) diff --git a/koans/vectors.lisp b/koans/vectors.lisp index 751116d2..70cb0b09 100644 --- a/koans/vectors.lisp +++ b/koans/vectors.lisp @@ -1,47 +1,50 @@ -;; 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. - -"vectors are just like rank 1 arrays" - -(define-test test-vector-types - " #(x y z) defines a vector literal containing x y z" - (true-or-false? ___ (typep #(1 11 111) 'vector)) - (assert-equal ___ (aref #(1 11 111) 1))) - - -(define-test test-length-works-on-vectors - (assert-equal (length #(1 2 3)) ___ )) - - -(define-test test-bit-vector - "#*0011 defines a bit vector literal with four elements, 0, 0, 1 and 1" - (assert-equal #*0011 (make-array '4 :element-type 'bit)) +;;; 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. + +;;; Vectors are one-dimensional arrays. This means that general array operations +;;; will work on vectors normally. However, Lisp also defines some functions for +;;; operating on sequences - which means, either vectors or lists. + +(define-test vector-basics + ;; #(...) is syntax sugar for defining literal vectors. + (let ((vector #(1 11 111))) + (true-or-false? ____ (typep vector 'vector)) + (assert-equal ____ (aref vector 1)))) + +(define-test length + ;; The function LENGTH works both for vectors and for lists. + (assert-equal ____ (length '(1 2 3))) + (assert-equal ____ (length #(1 2 3)))) + +(define-test bit-vector + ;; #*0011 defines a bit vector literal with four elements: 0, 0, 1 and 1. + (assert-equal #*0011 (make-array 4 :element-type 'bit :initial-contents ____)) (true-or-false? ____ (typep #*1001 'bit-vector)) (assert-equal ____ (aref #*1001 1))) +(define-test bitwise-operations + ;; Lisp defines a few bitwise operations that work on bit vectors. + (assert-equal ____ (bit-and #*1100 #*1010)) + (assert-equal ____ (bit-ior #*1100 #*1010)) + (assert-equal ____ (bit-xor #*1100 #*1010))) -(define-test test-some-bitwise-operations - (assert-equal ___ (bit-and #*1100 #*1010)) - (assert-equal ___ (bit-ior #*1100 #*1010)) - (assert-equal ___ (bit-xor #*1100 #*1010))) +(defun list-to-bit-vector (list) + ;; Implement a function that turns a list into a bit vector. + ____) - -(defun list-to-bit-vector (my-list) - nil) - -(define-test test-list-to-bit-vector - "you must complete list-to-bit-vector" +(define-test list-to-bit-vector + ;; You need to fill in the blank in LIST-TO-BIT-VECTOR. (assert-true (typep (list-to-bit-vector '(0 0 1 1 0)) 'bit-vector)) (assert-equal (aref (list-to-bit-vector '(0)) 0) 0) (assert-equal (aref (list-to-bit-vector '(0 1)) 1) 1) From aa735b32c398899862b2c87bea65f88152f95b8b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Wed, 6 May 2020 18:58:30 +0200 Subject: [PATCH 079/133] More cleaning up --- koans/arrays.lisp | 2 - koans/functions.lisp | 258 ++++++++++++++++++++----------------------- 2 files changed, 118 insertions(+), 142 deletions(-) diff --git a/koans/arrays.lisp b/koans/arrays.lisp index 7b2912e3..bbb9d67f 100644 --- a/koans/arrays.lisp +++ b/koans/arrays.lisp @@ -12,8 +12,6 @@ ;;; See the License for the specific language governing permissions and ;;; limitations under the License. -;;; See http://www.gigamonkeys.com/book/collections.html - (define-test basic-array-stuff ;; We make an 8x8 array and then fill it with a checkerboard pattern. (let ((chess-board (make-array '(8 8)))) diff --git a/koans/functions.lisp b/koans/functions.lisp index 7fcaae29..0dda2fb0 100644 --- a/koans/functions.lisp +++ b/koans/functions.lisp @@ -1,132 +1,113 @@ -;; 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. - - -; borrows from about_methods.py +;;; 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. (defun some-named-function (a b) (+ a b)) -(define-test test-call-a-function - "DEFUN defines global functions" - (assert-equal ___ (some-named-function 7 11))) - - -(define-test test-shadow-a-function - "Local functions are defined with FLET or LABELS. One major difference - between the two is that local functions defined with LABELS may refer - to themselves, whereas local functions defined with FLET may not." - (assert-eq 18 (some-named-function 7 11)) - "flet binds a function to a name within a lexical environment" - (flet ((some-named-function (a b) (* a b))) - (assert-equal ___ (some-named-function 7 11))) - (assert-equal ___ (some-named-function 7 11))) - - -; borrowed from Common Lisp The Language chapter 5.2.2 -(defun func-with-opt-params (&optional (a 2) (b 3) ) - ; each optional parameter has a form like (var default-val) - (list a b)) - -(define-test test-optional-parameters - "Optional parameters are filled in with their default value." - (assert-equal (func-with-opt-params :test-1 :test-2) ___) - (assert-equal (func-with-opt-params :test-1) ___) - (assert-equal (func-with-opt-params) ___)) - - -;; ---- - - -(defun func-with-opt-params-and-indication (&optional (a 2 a?) (b 3 b?)) - (list a a? b b?)) - -(define-test test-optional-parameters-with-indication - "Common Lisp optional params may bind a symbol which indicate whether the - value was provided or defaulted. Each optional parameter binding has the - form (var default-form supplied-p)." - (assert-equal (func-with-opt-params-and-indication :test-1 :test-2) ___) - (assert-equal (func-with-opt-params-and-indication :test-1) ___) - (assert-equal (func-with-opt-params-and-indication) ___)) - - -;; ---- - - -(defun func-with-rest-params (&rest x) +(define-test call-a-function + ;; DEFUN can be used to define global functions. + (assert-equal ____ (some-named-function 4 5)) + ;; FLET can be used to define local functions. + (flet ((another-named-function (a b) (* a b))) + (assert-equal ____ (another-named-function 4 5))) + ;; LABELS can be used to define local functions which can refer to themselves + ;; or each other. + (labels ((recursive-function (a b) + (if (or (= 0 a) (= 0 b)) + 1 + (+ (* a b) (recursive-function (1- a) (1- b)))))) + (assert-equal ____ (different-named-function 4 5)))) + +(define-test shadow-a-function + (assert-eq 18 (some-named-function 7 11)) + ;; FLET and LABELS can shadow function definitions. + (flet ((some-named-function (a b) (* a b))) + (assert-equal ____ (some-named-function 7 11))) + (assert-equal ____ (some-named-function 7 11))) + +(defun function-with-optional-parameters (&optional (a 2) (b 3) c) + ;; If an optional argument to a function is not provided, it is given its + ;; default value, or NIL, if no default value is specified. + (list a b c)) + +(define-test optional-parameters + (assert-equal ____ (function-with-optional-parameters 42 24 4224)) + (assert-equal ____ (function-with-optional-parameters 42 24)) + (assert-equal ____ (function-with-optional-parameters 42)) + (assert-equal ____ (function-with-optional-parameters))) + +(defun function-with-optional-indication + (&optional (a 2 a-provided-p) (b 3 b-provided-p)) + ;; It is possible to check whether an optional argument was provided. + (list a a-provided-p b b-provided-p)) + +(define-test optional-indication + (assert-equal ____ (function-with-optional-indication 42 24)) + (assert-equal ____ (function-with-optional-indication 42)) + (assert-equal ____ (function-with-optional-indication))) + +(defun function-with-rest-parameter (&rest x) + ;; A rest parameter gathers all remaining parameters in a list. x) -(define-test test-func-with-rest-params - "With &rest, the remaining params, are handed in as a list. Remaining - arguments (possibly none) are collected into a list." - (assert-equal (func-with-rest-params) ___) - (assert-equal (func-with-rest-params 1) ___) - (assert-equal (func-with-rest-params 1 :two 333) ___)) - - -;; ---- - - -(defun func-with-key-params (&key a b) - (list a b)) - -(define-test test-key-params () - "Key params allow the user to specify params in any order" - (assert-equal (func-with-key-params) ___) - (assert-equal (func-with-key-params :a 11 :b 22) ___) - ; it is not necessary to specify all key parameters - (assert-equal (func-with-key-params :b 22) ___) - ; order is not important - (assert-equal (func-with-key-params :b 22 :a 0) ___)) - -(defun func-key-params-can-have-defaults (&key (a 3 a?) (b 4 b?)) - (list a a? b b?)) - -(define-test test-key-params-can-have-defaults - "key parameters can have defaults also" - (assert-equal (func-key-params-can-have-defaults) ____) - (assert-equal (func-key-params-can-have-defaults :a 3 :b 4) ___) - (assert-equal (func-key-params-can-have-defaults :a 11 :b 22) ___) - (assert-equal (func-key-params-can-have-defaults :b 22) ___) - ; order is not important - (assert-equal (func-key-params-can-have-defaults :b 22 :a 0) ___)) - - -;; ---- - - -;; borrowed from common lisp the language 5.2.2 -(defun func-with-funky-parameters (a &rest x &key b (c a)) - (list a b c x)) +(define-test rest-parameter + (assert-equal ____ (function-with-rest-parameter)) + (assert-equal ____ (function-with-rest-parameter 1)) + (assert-equal ____ (function-with-rest-parameter 1 :two 333))) + +(defun function-with-keyword-parameters (&key (a :something) b c) + ;; A keyword parameters is similar to an optional parameter, but is provided + ;; by a keyword-value pair. + (list a b c)) + +(define-test keyword-parameters () + (assert-equal ____ (function-with-keyword-parameters)) + (assert-equal ____ (function-with-keyword-parameters :a 11 :b 22 :c 33)) + ;; It is not necessary to specify all keyword parameters. + (assert-equal ____ (func-with-key-params :b 22)) + ;; Keyword argument order is not important. + (assert-equal ____ (func-with-key-params :b 22 :c -5/2 :a 0)) + ;; Lisp handles duplicate keyword parameters. + (assert-equal ____ (func-with-key-params :b 22 :b 40 :b 812))) + +(defun function-with-keyword-indication + (&key (a 2 a-provided-p) (b 3 b-provided-p)) + ;; It is possible to check whether a keyword argument was provided. + (list a a-provided-p b b-provided-p)) + +(define-test keyword-indication + (assert-equal ____ (function-with-keyword-indication)) + (assert-equal ____ (function-with-keyword-indication :a 3 :b 4)) + (assert-equal ____ (function-with-keyword-indication :a 11 :b 22)) + (assert-equal ____ (function-with-keyword-indication :b 22)) + (assert-equal ____ (function-with-keyword-indication :b 22 :a 0))) + +(defun function-with-funky-parameters (a &rest x &key b (c a c-provided-p)) + ;; Lisp functions can have surprisingly complex lambda lists. + ;; A &rest parameter must come before &key parameters. + (list a b c c-provided-p x)) (define-test test-many-kinds-params - "CL provides the programmer with more than enough rope to hang himself." - (assert-equal (func-with-funky-parameters 1) ___) - (assert-equal (func-with-funky-parameters 1 :b 2) ___) - (assert-equal (func-with-funky-parameters 1 :b 2 :c 3) ___) - (assert-equal (func-with-funky-parameters 1 :c 3 :b 2) ___)) - - -;; Note that &rest parameters have to come before &key parameters. -;; This is an error: (defun f (&key a &rest x) () ) -;; But this is ok: (defun f (&rest x &key a) () ) - + (assert-equal (func-with-funky-parameters 1) ___) + (assert-equal (func-with-funky-parameters 1 :b 2) ___) + (assert-equal (func-with-funky-parameters 1 :b 2 :c 3) ___) + (assert-equal (func-with-funky-parameters 1 :c 3 :b 2) ___)) (define-test test-lambdas-are-nameless-functions - "A lambda form defines a function, but with no name. It is possible + "A lambda form defines a function, but with no name. It is possible to execute that function immediately, or put it somewhere for later use." - (assert-equal 19 ((lambda (a b) (+ a b)) 10 9)) + (assert-equal 19 ((lambda (a b) (+ a b)) 10 9)) (let ((my-function)) (setf my-function (lambda (a b) (* a b))) (assert-equal ___ (funcall my-function 11 9))) @@ -137,20 +118,17 @@ (assert-equal ___ (funcall (second list-of-functions) 2 33)))) (define-test test-lambdas-can-have-optional-params - (assert-equal ___ ((lambda (a &optional (b 100)) (+ a b)) 10 9)) - (assert-equal ___ ((lambda (a &optional (b 100)) (+ a b)) 10))) + (assert-equal ___ ((lambda (a &optional (b 100)) (+ a b)) 10 9)) + (assert-equal ___ ((lambda (a &optional (b 100)) (+ a b)) 10))) -; returns sign x -(defun sign-of (x) - (if (< x 0) (return-from sign-of -1)) - (if (eq x 0) (return-from sign-of 0)) - 1) + ; returns sign x +(defun sign-of (x) (if (< x 0) (return-from sign-of -1)) (if (eq x 0) (return-from sign-of 0)) 1) (define-test test-return-from-function-early - (assert-equal (sign-of -5.5) ___) - (assert-equal (sign-of 0) ___) - (assert-equal (sign-of ___) 1)) + (assert-equal (sign-of -5.5) ___) + (assert-equal (sign-of 0) ___) + (assert-equal (sign-of ___) 1)) ;; ---- @@ -169,9 +147,9 @@ (define-test test-lexical-closure-over-adder () (let ((add-100 (adder 100)) (add-500 (adder 500))) - "add-100 and add-500 now refer to different bindings to x" - (assert-equal ___ (funcall add-100 3)) - (assert-equal ___ (funcall add-500 3)))) + "add-100 and add-500 now refer to different bindings to x" + (assert-equal ___ (funcall add-100 3)) + (assert-equal ___ (funcall add-500 3)))) ;; ---- @@ -189,16 +167,16 @@ (function (lambda (y) (setq x y))))) (define-test test-lexical-closure-interactions - "An illustration of how lexical closures may interact." + "An illustration of how lexical closures may interact." (let ((tangled-funs-1 (two-funs 1)) (tangled-funs-2 (two-funs 2))) - (assert-equal (funcall (first tangled-funs-1)) ___) - (funcall (second tangled-funs-1) 0) - (assert-equal (funcall (first tangled-funs-1)) ___) + (assert-equal (funcall (first tangled-funs-1)) ___) + (funcall (second tangled-funs-1) 0) + (assert-equal (funcall (first tangled-funs-1)) ___) - (assert-equal (funcall (first tangled-funs-2)) ___) - (funcall (second tangled-funs-2) 100) - (assert-equal (funcall (first tangled-funs-2)) ___))) + (assert-equal (funcall (first tangled-funs-2)) ___) + (funcall (second tangled-funs-2) 100) + (assert-equal (funcall (first tangled-funs-2)) ___))) (define-test test-apply-function-with-apply @@ -212,8 +190,8 @@ (assert-equal ___ (apply f1 '(1 2))) (assert-equal ___ (apply f2 '(1 2))) - ; after the function name, the parameters are consed onto the front - ; of the very last parameter + ; after the function name, the parameters are consed onto the front + ; of the very last parameter (assert-equal ___ (apply f1 1 2 '(3))) (assert-equal ___ (apply f3 1 2 3 4 '())))) From 54bc26b8821b32e4a1c2c6a94756a11732f5bcf9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Wed, 6 May 2020 19:59:26 +0200 Subject: [PATCH 080/133] Even more koans fixed --- koans/control-statements.lisp | 22 ++--- koans/functions.lisp | 159 ++++++++++++++-------------------- koans/multiple-values.lisp | 2 +- koans/strings.lisp | 123 +++++++++++++------------- 4 files changed, 137 insertions(+), 169 deletions(-) diff --git a/koans/control-statements.lisp b/koans/control-statements.lisp index 3e071dcc..8db29d6f 100644 --- a/koans/control-statements.lisp +++ b/koans/control-statements.lisp @@ -12,16 +12,18 @@ ;; See the License for the specific language governing permissions and ;; limitations under the License. +;; TODO return-from + (define-test test-if-then-else - (let ((result)) - (if t - (setf result "true value") - (setf result "false value")) - (assert-equal result ____) - (if nil - (setf result "true value") - (setf result "false value")) - (assert-equal result ____))) + (let ((result)) + (if t + (setf result "true value") + (setf result "false value")) + (assert-equal result ____) + (if nil + (setf result "true value") + (setf result "false value")) + (assert-equal result ____))) (define-test test-when-and-unless @@ -65,4 +67,4 @@ (setf x (+ 1 x)) nil (setf x (+ 1 x))) - x))) \ No newline at end of file + x))) diff --git a/koans/functions.lisp b/koans/functions.lisp index 0dda2fb0..2b14d116 100644 --- a/koans/functions.lisp +++ b/koans/functions.lisp @@ -98,112 +98,83 @@ ;; A &rest parameter must come before &key parameters. (list a b c c-provided-p x)) -(define-test test-many-kinds-params +(define-test funky-parameters (assert-equal (func-with-funky-parameters 1) ___) (assert-equal (func-with-funky-parameters 1 :b 2) ___) (assert-equal (func-with-funky-parameters 1 :b 2 :c 3) ___) (assert-equal (func-with-funky-parameters 1 :c 3 :b 2) ___)) -(define-test test-lambdas-are-nameless-functions - "A lambda form defines a function, but with no name. It is possible - to execute that function immediately, or put it somewhere for later use." - (assert-equal 19 ((lambda (a b) (+ a b)) 10 9)) - (let ((my-function)) - (setf my-function (lambda (a b) (* a b))) - (assert-equal ___ (funcall my-function 11 9))) - (let ((list-of-functions nil)) - (push (lambda (a b) (+ a b)) list-of-functions) - (push (lambda (a b) (* a b)) list-of-functions) - (push (lambda (a b) (- a b)) list-of-functions) - (assert-equal ___ (funcall (second list-of-functions) 2 33)))) - -(define-test test-lambdas-can-have-optional-params +(define-test lambda + ;; A list form starting with the symbol LAMBDA denotes an anonymous function. + ;; It is possible to call that function immediately or to store it for later + ;; use. + (let ((my-function (lambda (a b) (* a b)))) + (assert-equal ____ (funcall my-function 11 9))) + ;; A LAMBDA form is allowed to take the place of a function name. + (assert-equal ____ ((lambda (a b) (+ a b)) 10 9)) + (let ((functions (list (lambda (a b) (+ a b)) + (lambda (a b) (- a b)) + (lambda (a b) (* a b)) + (lambda (a b) (/ a b))))) + (assert-equal ____ (funcall (first functions) 2 33)) + (assert-equal ____ (funcall (second functions) 2 33)) + (assert-equal ____ (funcall (third functions) 2 33)) + (assert-equal ____ (funcall (fourth functions) 2 33)))) + +(define-test lambda-with-optional-parameters (assert-equal ___ ((lambda (a &optional (b 100)) (+ a b)) 10 9)) (assert-equal ___ ((lambda (a &optional (b 100)) (+ a b)) 10))) - - ; returns sign x -(defun sign-of (x) (if (< x 0) (return-from sign-of -1)) (if (eq x 0) (return-from sign-of 0)) 1) - -(define-test test-return-from-function-early - (assert-equal (sign-of -5.5) ___) - (assert-equal (sign-of 0) ___) - (assert-equal (sign-of ___) 1)) - - -;; ---- - - -;; Lambdas create "lexical closures", meaning that the resulting function, when -;; called, will execute in an environment wherein the lexical bindings to all -;; referred to names still apply. -;; This example from "Common Lisp The Language" Ch. 7 - -(defun adder (x) - "The result of (adder n) is a nameless function with one parameter. - This function will add n to its argument." +(defun make-adder (x) + ;; MAKE-ADDER will create a function that closes over the parameter X. + ;; The parameter will be remembered as a part of the environment of the + ;; returned function, which will continue refering to it. (lambda (y) (+ x y))) -(define-test test-lexical-closure-over-adder () - (let ((add-100 (adder 100)) - (add-500 (adder 500))) - "add-100 and add-500 now refer to different bindings to x" - (assert-equal ___ (funcall add-100 3)) - (assert-equal ___ (funcall add-500 3)))) - - -;; ---- - - -;; The closure gives the returned function access to the bindings, not just the -;; values. This means that two functions which close over the same variables -;; will always see the same values of those variables if one does a setq. +(define-test lexical-closures + (let ((adder-100 (make-adder 100)) + (adder-500 (make-adder 500))) + ;; ADD-100 and ADD-500 now close over different values. + (assert-equal ____ (funcall adder-100 3)) + (assert-equal ____ (funcall adder-500 3)))) -(defun two-funs (x) - "Returns a list of two functions. - The first takes no parameters and returns x. - The second takes one parameter, y, and resets x to the value of y." +(defun make-reader-and-writer (x) + ;; Both returned functions will refer to the same place. (list (function (lambda () x)) (function (lambda (y) (setq x y))))) (define-test test-lexical-closure-interactions - "An illustration of how lexical closures may interact." - (let ((tangled-funs-1 (two-funs 1)) - (tangled-funs-2 (two-funs 2))) - (assert-equal (funcall (first tangled-funs-1)) ___) - (funcall (second tangled-funs-1) 0) - (assert-equal (funcall (first tangled-funs-1)) ___) - - (assert-equal (funcall (first tangled-funs-2)) ___) - (funcall (second tangled-funs-2) 100) - (assert-equal (funcall (first tangled-funs-2)) ___))) - - -(define-test test-apply-function-with-apply - "APPLY calls the function parameter on a list of all the remaining - parameters" - (let (f1 f2 f3) - (setq f1 '+) - (setq f2 '-) - (setq f3 'max) - - (assert-equal ___ (apply f1 '(1 2))) - (assert-equal ___ (apply f2 '(1 2))) - - ; after the function name, the parameters are consed onto the front - ; of the very last parameter - (assert-equal ___ (apply f1 1 2 '(3))) - (assert-equal ___ (apply f3 1 2 3 4 '())))) - - -(define-test test-apply-function-with-funcall - "FUNCALL calls the function parameter on a list of all the remaining - parameters. Remaining params do not expect a final list." - (let (f1 f2 f3) - (setq f1 '+) - (setq f2 '-) - (setq f3 'max) - (assert-equal ___ (funcall f1 1 2)) - (assert-equal ___ (funcall f2 1 2)) - (assert-equal ___ (funcall f1 1 2 3)) - (assert-equal ___ (funcall f3 1 2 3 4)))) + ;; The macro DESTRUCTURING-BIND is like LET, except it binds the variables + ;; listed in its first argument to the parts of the list returned by the form + ;; that is its second argument. + (destructuring-bind (reader-1 writer-1) (make-reader-and-writer 1) + (destructuring-bind (reader-2 writer-2) (make-reader-and-writer :one)) + (assert-equal ____ (funcall reader-1)) + (funcall writer-1 0) + (assert-equal ____ (funcall reader-1)) + ;; The two different function pairs refer to different places. + (assert-equal ____ (funcall reader-2)) + (funcall writer-2 :zero) + (assert-equal ____ (funcall reader-2)))) + +(define-test apply + ;; The function APPLY applies a function to a list of arguments. + (let ((function (lambda (x y z) (+ x y z)))) + (assert-equal ____ (apply function '(100 20 3)))) + ;; FUNCTION is a special operator that retrieves function objects, defined + ;; both globally and locally. #'X is syntax sugar for (FUNCTION X). + (assert-equal ____ (apply (function +) '(1 2))) + (assert-equal ____ (apply #'- '(1 2))) + ;; Only the last argument to APPLY must be a list. + (assert-equal ____ (apply #'+ 1 2 '(3))) + (assert-equal ____ (apply #'max 1 2 3 4 '()))) + +(define-test funcall + ;; The function FUNCALL calls a function with arguments, not expecting a final + ;; list of arguments. + (let ((function (lambda (x y z) (+ x y z)))) + (assert-equal ____ (funcall function 300 20 1))) + (assert-equal ____ (funcall (function +) 1 2)) + (assert-equal ____ (funcall #'- 1 2)) + (assert-equal ____ (funcall #'+ 1 2 3)) + (assert-equal ____ (funcall #'max 1 2 3 4))) diff --git a/koans/multiple-values.lisp b/koans/multiple-values.lisp index b98014e9..5459c0ac 100644 --- a/koans/multiple-values.lisp +++ b/koans/multiple-values.lisp @@ -30,7 +30,7 @@ (define-test binding-and-setting-multiple-values ;; The macro MULTIPLE-VALUE-BIND is like LET, except it binds the variables - ;; listed in its first argument to the values returned by the form in its + ;; listed in its first argument to the values returned by the form that is its ;; second argument. (multiple-value-bind (x y) (next-fib 3 5) (let ((result (* x y))) diff --git a/koans/strings.lisp b/koans/strings.lisp index 2baf4676..7fca67bf 100644 --- a/koans/strings.lisp +++ b/koans/strings.lisp @@ -1,78 +1,73 @@ -;; 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. +;;; 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. -(define-test test-double-quoted-strings-are-strings - (let ((my-string "do or do not")) - (true-or-false? ___ (typep my-string 'string)) - "strings are the same thing as vectors of characters" - (true-or-false? ___ (typep my-string 'array)) - (assert-equal (aref "meat" 2) (aref "fiesta" 5)) - "strings are not integers :p" - (true-or-false? ___ (typep my-string 'integer)))) +(define-test what-is-a-string + (let ((string "Do, or do not. There is no try.")) + (true-or-false? ____ (typep string 'string)) + ;; Strings are vectors of characters. + (true-or-false? ____ (typep string 'array)) + (true-or-false? ____ (typep string 'vector)) + (true-or-false? ____ (typep string '(vector character))) + (true-or-false? ____ (typep string 'integer)))) +(define-test multiline-string + ;; A Lisp string can span multiple lines. + (let ((string "this is + a multi + line string")) + (true-or-false? ___ (typep string 'string)))) -(define-test test-multi-line-strings-are-strings - (let ((my-string "this is - a multi - line string")) - (true-or-false? ___ (typep my-string 'string)))) +(define-test escapes-in-strings + ;; Quotes and backslashes in Lisp strings must be escaped. + (let ((my-string "this string has one of these \" and a \\ in it")) + (true-or-false? ____ (typep my-string 'string)))) +(define-test substrings + ;; Since strings are sequences, it is possible to use SUBSEQ on them. + (let ((string "Lorem ipsum dolor sit amet")) + (assert-equal ____ (subseq string 12)) + (assert-equal ____ (subseq string 6 11)) + (assert-equal ____ (subseq string 1 5)))) -(define-test test-escape-quotes - (let ((my-string "this string has one of these \" in it")) - (true-or-false? ___ (typep my-string 'string)))) - - -; This test from common lisp cookbook -(define-test test-substrings - "since strings are sequences, you may use subseq" - (let ((my-string "Groucho Marx")) - (assert-equal "Marx" (subseq my-string 8)) - (assert-equal (subseq my-string 0 7) ____) - (assert-equal (subseq my-string 1 5) ____))) - -(define-test test-accessing-individual-characters - "char literals look like this" - (true-or-false? ___ (typep #\a 'character)) - (true-or-false? ___ (typep "A" 'character)) - (true-or-false? ___ (typep #\a 'string)) - "char is used to access individual characters" +(define-test strings-versus-characters + ;; Strings and characters have distinct types. + (true-or-false? ____ (typep #\a 'character)) + (true-or-false? ____ (typep "A" 'character)) + (true-or-false? ____ (typep #\a 'string)) + ;; One can use both AREF and CHAR to refer to characters in a string. (let ((my-string "Cookie Monster")) - (assert-equal (char my-string 0) #\C) - (assert-equal (char my-string 3) #\k) - (assert-equal (char my-string 7) ___))) - + (assert-equal ____ (char my-string 0)) + (assert-equal ____ (char my-string 3)) + (assert-equal ____ (aref my-string 7)))) (define-test test-concatenating-strings - "concatenating strings in lisp is a little cumbersome" - (let ((a "this") - (b "is") - (c "unwieldy")) - (assert-equal ___ (concatenate 'string a " " b " " c)))) - + ;; Concatenating strings in Common Lisp is possible, if a little cumbersome. + (let ((a "Lorem") + (b "ipsum") + (c "dolor")) + (assert-equal ____ (concatenate 'string a " " b " " c)))) (define-test test-searching-for-characters - "you can use position to detect characters in strings - (or elements of sequences)" - (assert-equal ___ (position #\b "abc")) - (assert-equal ___ (position #\c "abc")) - (assert-equal ___ (find #\d "abc"))) - + ;; The function POSITION can be used to find the first position of an element + ;; in a sequence. If the element is not found, NIL is returned. + (assert-equal ____ (position #\b "abc")) + (assert-equal ____ (position #\c "abc")) + (assert-equal ____ (position #\d "abc"))) (define-test test-finding-substrings - "search finds subsequences" + ;; The function SEARCH can be used to search a sequence for subsequences. (let ((title "A supposedly fun thing I'll never do again")) - (assert-equal 2 (search "supposedly" title)) - (assert-equal 12 (search "CHANGETHISWORD" title)))) + (assert-equal ____ (search "supposedly" title)) + (assert-equal 12 (search ____ title)))) From 0aee4391f613e3bf5cccef57cbfd7cb08f5cc9d5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Wed, 6 May 2020 21:10:31 +0200 Subject: [PATCH 081/133] Fix structures --- koans/structures.lisp | 208 +++++++++++++++++++++--------------------- 1 file changed, 104 insertions(+), 104 deletions(-) diff --git a/koans/structures.lisp b/koans/structures.lisp index aa04a9cb..e6c89c38 100644 --- a/koans/structures.lisp +++ b/koans/structures.lisp @@ -1,104 +1,104 @@ -;; 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. - - -;; Lisp structures encapsulate data which belongs together. They are -;; a template of sorts, providing a way to generate multiple instances of -;; uniformly organized information -;; -;; Defining a struct also interns accessor functions to get and set the fields -;; of the structure. - - -;; Define a new struct with the defstruct form. The following call creates a -;; new structure type named basketball-player, with slots named: -;; 'name', 'team', and number. -(defstruct basketball-player name team number) - -(define-test test-make-struct - ;; Create a basketball structure instance, and then read out the values. - (let ((player-1 (make-basketball-player - :name "larry" :team :celtics :number 33))) - (assert-equal "larry" (basketball-player-name player-1)) - (assert-equal ___ (basketball-player-team player-1)) - (assert-equal ___ (basketball-player-number player-1)) - (assert-equal 'basketball-player (type-of player-1)) - (setf (basketball-player-team player-1) :RETIRED) - (assert-equal ___ (basketball-player-team player-1)))) - - -;; Struct fields can have default values -;; fields without explicit defaults default to nil. - -(defstruct baseball-player name (position :outfield) (team :red-sox)) - -(define-test test-struct-defaults - (let ((player-2 (make-baseball-player))) - (assert-equal ___ (baseball-player-position player-2)) - (assert-equal ___ (baseball-player-team player-2)) - (assert-equal ___ (baseball-player-name player-2)))) - - -;; The accessor names can get pretty long. It's possible to specify -;; a nickname to make code readable with the :conc-name option. - -(defstruct (american-football-player (:conc-name nfl-guy-)) name position team) - -(define-test test-abbreviated-struct-access - (let ((player-3 (make-american-football-player - :name "Drew Brees" :position :QB :team "Saints"))) - (assert-equal ___ (nfl-guy-position player-3)))) - - -;; Structs can be defined as EXTENSIONS to previous structures. -;; This form of inheritance allows composition of objects. - -(defstruct (nba-contract (:include basketball-player)) salary start-year end-year) - -(define-test test-structure-extension - (let ((contract-1 (make-nba-contract - :salary 136000000 - :start-year 2004 - :end-year 2011 - :name "Kobe Bryant" - :team :LAKERS - :number 24))) - (assert-equal ___ (nba-contract-start-year contract-1)) - (assert-equal ___ (type-of contract-1)) - ;; do inherited structures follow the rules of type hierarchy? - (true-or-false? ___ (typep contract-1 'BASKETBALL-PLAYER)) - ;; can you access structure fields with the inherited accessors? - (assert-equal ___ (nba-contract-team contract-1)) - (assert-equal ___ (basketball-player-team contract-1)))) - - -;; Copying of structs is handled with the copy-{name} form. Note that -;; copying is shallow. - -(define-test test-structure-copying - (let ((manning-1 (make-american-football-player :name "Manning" :team '("Colts" "Broncos"))) - (manning-2 (make-american-football-player :name "Manning" :team '("Colts" "Broncos")))) - ;; manning-1 and manning-2 are different objects - (true-or-false? ___ (eq manning-1 manning-2)) - ;; but manning-1 and manning-2 contain the same information - ;; (note the equalp instead of eq - (true-or-false? ___ (equalp manning-1 manning-2)) - ;; copied structs are much the same. - (true-or-false? ___ (equalp manning-1 (copy-american-football-player manning-1))) - (true-or-false? ___ (eq manning-1 (copy-american-football-player manning-1))) - ;; note that the copying is shallow - (let ((shallow-copy (copy-american-football-player manning-1))) - (setf (car (nfl-guy-team manning-1)) "Giants") - (assert-equal ___ (car (nfl-guy-team manning-1))) - (assert-equal ___ (car (nfl-guy-team shallow-copy)))))) +;;; 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. + +;;; Lisp structures encapsulate data which belongs together. They are a template +;;; of sorts, providing a way to generate multiple instances of uniformly +;;; organized information +;;; Defining a structure also interns accessor functions to get and set the +;;; slots of that structure. + +;;; The following form creates a new structure class named BASKETBALL-PLAYER +;;; with slots named NAME, TEAM, and NUMBER. +;;; This additionally creates functions MAKE-BASKETBALL-PLAYER, +;;; COPY-BASKETBALL-PLAYER, BASKETBALL-PLAYER-P, BASKETBALL-PLAYER-NAME, +;;; BASKETBALL-PLAYER-TEAM, and BASKETBALL-PLAYER-NUMBER. + +(defstruct basketball-player + name team number) + +(define-test make-struct + (let ((player (make-basketball-player :name "Larry" :team :celtics :number 33))) + (true-or-false? ____ (basketball-player-p player)) + (assert-equal ____ (basketball-player-name player)) + (assert-equal ____ (basketball-player-team player)) + (assert-equal ____ (basketball-player-number player)) + (setf (basketball-player-team player) :retired) + (assert-equal ____ (basketball-player-team player)))) + +;;; Structure fields can have default values. + +(defstruct baseball-player + name (team :red-sox) (position :outfield)) + +(define-test struct-defaults + (let ((player (make-baseball-player))) + ;; We have not specified a default value for NAME, therefore we cannot + ;; read it here - it would invoke undefined behaviour. + (assert-equal ____ (baseball-player-team player)) + (assert-equal ____ (baseball-player-position player)))) + +;;; The accessor names can get pretty long. It's possible to specify a different +;;; prefix with the :CONC-NAME option. + +(defstruct (american-football-player (:conc-name nfl-guy-)) + name position team) + +(define-test struct-access + (let ((player (make-american-football-player + :name "Drew Brees" :position :qb :team "Saints"))) + (assert-equal ____ (nfl-guy-name player)) + (assert-equal ____ (nfl-guy-team player)) + (assert-equal ____ (nfl-guy-position player)))) + +;;; Structs can be defined to include other structure definitions. +;;; This form of inheritance allows composition of objects. + +(defstruct (nba-contract (:include basketball-player)) + salary start-year end-year) + +(define-test structure-inheritance + (let ((contract (make-nba-contract :salary 136000000 + :start-year 2004 :end-year 2011 + :name "Kobe Bryant" + :team :lakers :number 24))) + (assert-equal ____ (nba-contract-start-year contract)) + (assert-equal ____ (type-of contract)) + ;; Inherited structures follow the rules of type hierarchy. + (true-or-false? ____ (typep contract 'basketball-player)) + ;; One can access structure fields both with the structure's own accessors + ;; and with the inherited accessors. + (assert-equal ____ (nba-contract-team contract)) + (assert-equal ____ (basketball-player-team contract)))) + +;;; Copying a structure named FOO is handled with the COPY-FOO function. +;;; All such copies are shallow. + +(define-test structure-equality-and-copying + (let ((manning-1 (make-american-football-player + :name "Manning" :team (list "Colts" "Broncos"))) + (manning-2 (make-american-football-player + :name "Manning" :team (list "Colts" "Broncos")))) + ;; MANNING-1 and MANNING-2 are different objects... + (true-or-false? ____ (eq manning-1 manning-2)) + ;;...but they contain the same information. + (true-or-false? ____ (equalp manning-1 manning-2)) + (let ((manning-3 (copy-american-football-player manning-1))) + (true-or-false? ____ (eq manning-1 manning-3)) + (true-or-false? ____ (equalp manning-1 manning-3)) + ;; Setting the slot of one instance does not modify the others. + (setf (car (nfl-guy-team manning-1)) "Giants") + (true-or-false? ____ (string= (car (nfl-guy-team manning-1)) + (car (nfl-guy-team manning-3)))) + (assert-equal ____ (car (nfl-guy-team manning-1))) + (assert-equal ____ (car (nfl-guy-team manning-1)))))) From 36deb21b8cc9fcaf084edd56d8ebc38798079ee0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Thu, 7 May 2020 14:22:00 +0200 Subject: [PATCH 082/133] Some more fixes --- .koans | 4 +- koans/control-statements.lisp | 124 +++++++------- koans/format.lisp | 140 +++++++++------- koans/iteration.lisp | 172 +++++++------------ koans/loops.lisp | 303 ++++++++++++++++------------------ koans/mapcar-and-reduce.lisp | 161 ++++++++++-------- koans/scoring-project.lisp | 167 +++++++++---------- koans/type-checking.lisp | 130 +++++++-------- 8 files changed, 578 insertions(+), 623 deletions(-) diff --git a/.koans b/.koans index bf11e5fb..198230a3 100644 --- a/.koans +++ b/.koans @@ -17,14 +17,14 @@ #:iteration #:mapcar-and-reduce #:control-statements - #:condition-handlers #:loops - #:triangle-project #:scoring-project #:format #:type-checking #:clos #:std-method-comb + #:condition-handlers + #:triangle-project #:dice-project #:macros #:scope-and-extent diff --git a/koans/control-statements.lisp b/koans/control-statements.lisp index 8db29d6f..a5952854 100644 --- a/koans/control-statements.lisp +++ b/koans/control-statements.lisp @@ -1,70 +1,68 @@ -;; 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. +;;; 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. -;; TODO return-from - -(define-test test-if-then-else +(define-test if + ;; IF only evaluates and returns one branch of a conditional expression. + (assert-equal ____ (if t :true :false)) + (assert-equal ____ (if nil :true :false)) + ;; This also applies to side effects that migh or might not be evaluated. (let ((result)) (if t - (setf result "true value") - (setf result "false value")) - (assert-equal result ____) + (setf result :true) + (setf result :false)) + (assert-equal ____ result) (if nil - (setf result "true value") - (setf result "false value")) - (assert-equal result ____))) - - -(define-test test-when-and-unless - (let ((result-1 nil) - (result-2 nil) - (when-nums nil) - (unless-nums nil)) - (dolist (x '(1 2 3 4 5 6 7 8 9 10)) - (when (> x 5) - (setf result-1 x) - (push x when-nums)) - (unless (> x 5) - (setf result-2 x) - (push x unless-nums))) - (assert-equal result-1 ___) - (assert-equal result-2 ___) - (assert-equal when-nums ___) - (assert-equal unless-nums ___))) - + (setf result :true) + (setf result :false)) + (assert-equal ____ result))) -(define-test test-and-short-circuits - "and only evaluates forms until one evaluates to nil" - (assert-equal - ____ - (let ((x 0)) - (and - (setf x (+ 1 x)) - (setf x (+ 1 x)) - nil ;; <- ends execution of and. - (setf x (+ 1 x))) - x))) +(define-test when-unless + ;; WHEN and UNLESS are like one-branched IF statements. + (let ((when-result nil) + (when-numbers '()) + (unless-result nil) + (unless-numbers '())) + (dolist (x '(1 2 3 4 5 6 7 8 9 10)) + (when (> x 5) + (setf when-result x) + (push x when-numbers)) + (unless (> x 5) + (setf unless-result x) + (push x unless-numbers))) + (assert-equal ____ when-result) + (assert-equal ____ when-numbers) + (assert-equal ____ unless-result) + (assert-equal ____ unless-numbers))) +(define-test and-short-circuit + ;; AND only evaluates forms until one evaluates to NIL. + (assert-equal ____ + (let ((x 0)) + (and + (setf x (+ 1 x)) + (setf x (+ 1 x)) + nil + (setf x (+ 1 x))) + x))) -(define-test test-or-also-short-circuits - "or only evaluates until one argument evaluates to non-nil" - (assert-equal - ____ - (let ((x 0)) - (or - (setf x (+ 1 x)) - (setf x (+ 1 x)) - nil - (setf x (+ 1 x))) - x))) +(define-test or-short-circuit + ;; AND only evaluates forms until one evaluates to non-NIL. + (assert-equal ____ + (let ((x 0)) + (or + (setf x (+ 1 x)) + (setf x (+ 1 x)) + nil + (setf x (+ 1 x))) + x))) diff --git a/koans/format.lisp b/koans/format.lisp index 804a9611..39d0e6fa 100644 --- a/koans/format.lisp +++ b/koans/format.lisp @@ -1,56 +1,84 @@ -;; 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. - - -;; FORMAT is lisp's counterpart to the c function printf. Refer to -;; http://www.gigamonkeys.com/book/a-few-format-recipes.html for more -;; on this topic. - - -;; FORMAT takes two fixed parameters. The first one specifies an -;; output stream that the result goes to, and if left as nil, FORMAT -;; will return the output as a string instead. The second parameter -;; specifies the format, where format specifier will be replaced by -;; formatting the rest of the parameters. - -(define-test test-format-with-plain-text - "If there is no format specifier, FORMAT just returns the string - itself." - (assert-equal ___ (format nil "this is plain text."))) - -(define-test test-format-with-general-specifier - "~a is a general specifier that translates to the print form of a - parameter." - (assert-equal ___ (format nil "~a" 42)) - (assert-equal ___ (format nil "~a" #\C)) - (assert-equal ___ (format nil "~a" "galaxy far far away")) - ;; ~a can also translate to list - ;; and parameters to FORMAT are passed by value - (assert-equal ___ - (format nil "~a evaluates to ~a" - '(/ 8 (- 3 (/ 8 3))) - (/ 8 (- 3 (/ 8 3)))))) - -(define-test some-fancy-specifiers - "format enclosed by ~{ and ~} applies to every element in a list." - (assert-equal ___ - (format nil "~{[~a]~}" '(1 2 3 4))) - ;; ~^ within the ~{ ~} stops processing the last element in the list. - (assert-equal "1|2|3|4|" (format nil ___ '(1 2 3 4))) - (assert-equal ___ (format nil "~{~a~^|~}" '(1 2 3 4))) - ;; ~r reads the integer - (assert-equal ___ (format nil "~r" 42)) - ;; put them all together - (assert-equal ___ - (format nil "~{~r~^,~}" '(1 2 3 4)))) +;;; 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. + +;;; The function FORMAT is used to create formatted output. It is similar to +;;; the C function printf(). +;;; See http://www.gigamonkeys.com/book/a-few-format-recipes.html + +;;; T as the first argument to FORMAT prints the string to standard output. +;;; NIL as the first argument to FORMAT causes it to return the string. + +(define-test format-basic + ;; If there are no format directives in the string, FORMAT will return + ;; a string that is STRING= to its format control. + (assert-equal ____ (format nil "Lorem ipsum dolor sit amet"))) + +(define-test format-aesthetic + ;; The ~A format directive creates aesthetic output. + (assert-equal ____ (format nil "This is the number ~A" 42)) + (assert-equal ____ (format nil "This is the keyword ~A" :foo)) + (assert-equal ____ (format nil "~A evaluates to ~A" + '(/ 24 (- 3 (/ 8 3))) + (/ 24 (- 3 (/ 8 3))))) + (assert-equal ____ (format nil "This is the character ~A" #\C)) + (assert-equal ____ (format nil "In a ~A" "galaxy far far away"))) + +(define-test format-standard + ;; The ~S format directive prints objects with escape characters. + ;; Not all Lisp objects require to be escaped. + (assert-equal ____ (format nil "This is the number ~S" 42)) + (assert-equal ____ (format nil "~S evaluates to ~S" + '(/ 24 (- 3 (/ 8 3))) + (/ 24 (- 3 (/ 8 3))))) + ;; Keywords are printed with their leading colon. + (assert-equal ____ (format nil "This is the keyword ~S" :foo)) + ;; Characters are printed in their #\X form. The backslash will need to be + ;; escaped inside the printed string, just like in "#\\X". + (assert-equal ____ (format nil "This is the character ~S" #\C)) + ;; Strings include quote characters, which must be escaped: + ;; such a string might look in code like "foo \"bar\"". + (assert-equal ____ (format nil "In a ~S" "galaxy far far away"))) + +(define-test format-radix + ;; The ~B, ~O, ~D, and ~X radices print numbers in binary, octal, decimal, and + ;; hexadecimal notation. + (assert-equal ____ (format nil "This is the number ~B" 42)) + (assert-equal ____ (format nil "This is the number ~O" 42)) + (assert-equal ____ (format nil "This is the number ~D" 42)) + (assert-equal ____ (format nil "This is the number ~X" 42)) + ;; We can specify a custom radix by using the ~R directive. + (assert-equal ____ (format nil "This is the number ~3R" 42)) + ;; It is possible to print whole forms this way. + (let ((form '(/ 24 (- 3 (/ 8 3)))) + (result (/ 24 (- 3 (/ 8 3))))) + (assert-equal ____ (format nil "~B evaluates to ~B" form result)) + (assert-equal ____ (format nil "~O evaluates to ~O" form result)) + (assert-equal ____ (format nil "~D evaluates to ~D" form result)) + (assert-equal ____ (format nil "~X evaluates to ~X" form result)) + (assert-equal ____ (format nil "~3R evaluates to ~3R" form result)))) + +(define-test format-iteration + ;; The ~{ and ~} directives iterate over a list. + (assert-equal ____ (format nil "~{[~A]~}" '(1 2 3 4 5 6))) + (assert-equal ____ (format nil "~{[~A ~A]~}" '(1 2 3 4 5 6))) + ;; The directive ~^ aborts iteration when no more elements remain. + (assert-equal ____ (format nil "~{[~A]~^, ~}" '(1 2 3 4 5 6)))) + +(define-test format-case + ;; The ~( and ~) directives adjust the string case. + (assert-equal ____ (format nil "~(~A~)" "The QuIcK BROWN fox")) + ;; Some FORMAT directives can be further adjusted with the : and @ modifiers. + (assert-equal ____ (format nil "~:(~A~)" "The QuIcK BROWN fox")) + (assert-equal ____ (format nil "~@(~A~)" "The QuIcK BROWN fox")) + (assert-equal ____ (format nil "~:@(~A~)" "The QuIcK BROWN fox"))) diff --git a/koans/iteration.lisp b/koans/iteration.lisp index 61364c6f..20385cbd 100644 --- a/koans/iteration.lisp +++ b/koans/iteration.lisp @@ -1,116 +1,58 @@ -;; 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. +;;; 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. + +;;; Lisp has multiple options for iteration. +;;; This set of koans will introduce some of the most common ones. + +(define-test dolist + (let ((numbers '(4 8 15 16 23 42))) + ;; The macro DOLIST binds a variable to subsequent elements of a list. + (let ((sum 0)) + (dolist (number numbers) + ;; (INCF PLACE N) is equivalent to (SETF PLACE (+ N PLACE)). + (incf sum number)) + (assert-equal ____ sum)) + ;; DOLIST can optionally return a value. + (let ((sum 0)) + (assert-equal ____ (dolist (number numbers sum) + (incf sum number)))))) + +(define-test dotimes + ;; The macro DOTIMES binds a variable to subsequent integers from 0 to + ;; (1- COUNT). + (let ((stack '())) + (dotimes (i 5) + (push i stack)) + (assert-equal ____ stack)) + ;; DOTIMES can optionally return a value. + (let ((stack '())) + (assert-equal ____ (dotimes (i 5 stack) + (push i stack))))) + +(define-test loop-basic-form + ;; The macro LOOP in its simple form loops forever. It is possible to stop the + ;; looping by calling the RETURN special form. + (let ((counter 0)) + (loop (incf counter) + (when (>= counter 100) + (return counter))) + (assert-equal ___ loop-counter)) + ;; The RETURN special form can return a value out of a LOOP. + (let ((loop-counter 0)) + (assert-equal ___ (loop (incf counter) + (when (>= counter 100) + (return counter))))) + ;; The extended form of LOOP will be contemplated in a future koan. + ) - -;; There are many options for iteration in lisp. -;; This set of koans will introduce a few of the most common ones - - -;; Dolist evaluates a form for every element of a list. - -(defvar some-primes '(10301 11311 19991 999565999)) - -(define-test test-dolist - "'dolist' iterates over values in a list, binding each value to a lexical - variable in turn" - (let ((how-many-in-list 0) - (biggest-in-list (first some-primes))) - "this dolist loops over some-primes, defined above" - (dolist (one-prime some-primes) - (if (> one-prime biggest-in-list) - (setf biggest-in-list one-prime)) - (incf how-many-in-list)) - (assert-equal ___ how-many-in-list) - (assert-equal ___ biggest-in-list)) - (let ((sum 0)) - "write your own dolist here to calculate the sum of some-primes - you may be interested in investigating the 'incf' function" - ;(dolist ... ) - (assert-equal 999607602 sum))) - - -(define-test test-dolist-with-return - "Dolist can accept a return variable, which will be the return value - upon completion of the iteration." - (let ((my-list '(1 2 3 4)) - (my-return)) - (dolist (x my-list my-return) - (push (* x x) my-return)) - (assert-equal ____ my-return))) - - -(define-test test-dotimes - "'dotimes' iterates over the integers from 0 to (limit - 1), - binding them in order to your selected symbol." - (let ((out-list nil)) - (dotimes (y 3) (push y out-list)) - (assert-equal out-list ___))) - - -(defvar *x* "global") -(define-test test-dotimes-binding - "dotimes establishes a local lexical binding which may shadow - a global value." - (dotimes (*x* 4) - (true-or-false? ___ (equal "global" *x*))) - (true-or-false? ___ (equal "global" *x*))) - - -(define-test test-loop-until-return - "Loop loops forever, unless some return condition is executed. - Note that the loop macro includes many additional options, - which will be covered in a future koan." - (let ((loop-counter 0)) - (loop - (incf loop-counter) - (if (>= loop-counter 100) (return loop-counter))) - (assert-equal ___ loop-counter))) - - -(define-test test-mapcar - "mapcar takes a list and a function. It returns a new list - with the function applied to each element of the input" - (let ((mc-result (mapcar #'evenp '(1 2 3 4 5)))) - (assert-equal mc-result ____))) - - -;; ---- - - -(defun vowelp (c) - "returns true if c is a vowel" - (find c "AEIOUaeiou")) - -(defun vowels-to-xs (my-string) - "converts all vowels in a string to the character 'x'" - (coerce - (loop for c across my-string - with new-c - do (setf new-c (if (vowelp c) #\x c)) - collect new-c) - 'string)) - -(define-test test-mapcar-with-defun - "mapcar is a convenient way to apply a function to a collection" - (assert-equal (vowels-to-xs "Astronomy") "xstrxnxmy") - (let* ((subjects '("Astronomy" "Biology" "Chemistry" "Linguistics")) - (mc-result (mapcar #'vowels-to-xs subjects))) - (assert-equal mc-result ____))) - - -;; ---- - -(define-test test-mapcar-with-lambda - (let ((mc-result (mapcar (lambda (x) (mod x 10)) '(21 152 403 14)))) - (assert-equal mc-result ____))) diff --git a/koans/loops.lisp b/koans/loops.lisp index 6fa3fc54..85429bdd 100644 --- a/koans/loops.lisp +++ b/koans/loops.lisp @@ -1,165 +1,140 @@ -;; 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. - -;; see http://www.gigamonkeys.com/book/loop-for-black-belts.html -;; "Loop for blackbelts" for more on the loop macro. - -(define-test test-basic-loop - (let* ((letters '(:a :b :c :d)) - (loop-result - (loop for letter in letters - collect letter))) - (assert-equal loop-result ____))) - - -(define-test test-compound-loop - (let* ((letters '(:a :b :c :d)) - (loop-result - (loop for letter in letters - for i from 1 to 1000 - collect (list i letter)))) - (assert-equal loop-result ____))) - - -(define-test test-counting-loop-skip-by-syntax - "with multiple 'for' clauses, loop ends when the first is exhausted" - (let* ((letters '(:a :b :c :d)) - (loop-result - (loop for letter in letters - for i from 0 to 1000 by 5 - collect (list i letter)))) - (assert-equal loop-result ____ ))) - - -(define-test test-counting-backwards - (let ((loop-result - (loop for i from 10 downto -10 by 5 - collect i ))) - (assert-equal loop-result ____ ))) - - -(define-test test-loop-in-vs-loop-on - (let* ((letters '(:a :b :c)) - (loop-result-in - (loop for letter in letters collect letter)) - (loop-result-on - (loop for letter on letters collect letter))) - (assert-equal loop-result-in ____) - (assert-equal loop-result-on ____ ))) - - -(define-test test-loop-in-skip-by - (let* ((letters '(:a :b :c :d :e :f)) - (loop-result-in - (loop for letter in letters collect letter)) - (loop-result-in-cdr - (loop for letter in letters by #'cdr collect letter)) - (loop-result-in-cddr - (loop for letter in letters by #'cddr collect letter)) - (loop-result-in-cdddr - (loop for letter in letters by #'cdddr collect letter))) - (assert-equal loop-result-in ____) - (assert-equal loop-result-in-cdr ____) - (assert-equal loop-result-in-cddr ____) - (assert-equal loop-result-in-cdddr ____))) - - -(define-test test-loop-across-vector - (let* ((my-vector (make-array '(5) :initial-contents '(0 1 2 3 4))) - (loop-result - (loop for val across my-vector collect val))) - (assert-equal ____ loop-result))) - - -(define-test test-loop-across-2d-array - (let* ((my-array (make-array '(3 3) :initial-contents '((0 1 2) (3 4 5) (6 7 8)))) - (loop-result - (loop for i from 0 below (array-total-size my-array) collect (row-major-aref my-array i)))) - (assert-equal loop-result ____ ))) - - -(define-test test-loop-across-2d-array-respecting-shape - (let* ((my-array (make-array '(3 2) :initial-contents '((0 1) (2 3) (4 5)))) - (loop-result - (loop for i from 0 below (array-dimension my-array 0) collect - (loop for j from 0 below (array-dimension my-array 1) collect - (expt (aref my-array i j) 2))))) - (assert-equal loop-result ____ ))) - - -(defvar books-to-heros) -(setf books-to-heros (make-hash-table :test 'equal)) -(setf (gethash "The Hobbit" books-to-heros) "Bilbo") -(setf (gethash "Where The Wild Things Are" books-to-heros) "Max") -(setf (gethash "The Wizard Of Oz" books-to-heros) "Dorothy") -(setf (gethash "The Great Gatsby" books-to-heros) "James Gatz") - - -(define-test test-loop-over-hash-tables - (let* ((pairs-in-table - (loop for k being the hash-keys in books-to-heros - using (hash-value v) - collect (list k v)))) +;;; 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. + +;;; The extended for of LOOP allows for advanced iteration. +;;; See http://www.gigamonkeys.com/book/loop-for-black-belts.html + +(define-test loop-collect + ;; LOOP can collect the results in various ways. + (let* ((result-1 (loop for letter in '(#\a \b #\c #\d) collect letter)) + (result-2 (loop for number in '(1 2 3 4 5) sum number)) + (result-3 (loop for list in '((foo) (bar) (baz)) append list))) + (assert-equal ____ result-1) + (assert-equal ____ result-2) + (assert-equal ____ result-3))) + +(define-test loop-multiple-variables + ;; With multiple FOR clauses, the loop ends when any of the provided lists are + ;; exhausted. + (let* ((letters '(:a :b :c :d)) + (result (loop for letter in letters + for i from 1 to 1000 + collect (list i letter)))) + (assert-equal ____ result))) + +(define-test loop-in-versus-loop-on + ;; Instead of iterating over each element of a list, we can iterate over each + ;; cons cell of a list. + (let* ((letters '(:a :b :c)) + (result-in (loop for thing in letters collect thing)) + (result-on (loop for thing on letters collect thing))) + (assert-equal ____ result-in) + (assert-equal ____ result-on))) + +(define-test loop-for-by + ;; Numeric iteration can go faster or slower if we use the BY keyword. + (let* ((result (loop for i from 0 to 30 by 5 collect i))) + (assert-equal ____ result))) + +(define-test loop-counting-backwards + ;; We can count downwards instead of upwards by using DOWNTO instead of TO. + (let ((result (loop for i from 5 downto -5 collect i))) + (assert-equal ____ result))) + +(define-test loop-list-by + ;; List iteration can go faster or slower if we use the BY keyword. + (let* ((letters '(:a :b :c :d :e :f)) + (result (loop for letter in letters collect letter)) + (result-cdr (loop for letter in letters by #'cdr collect letter)) + (result-cddr (loop for letter in letters by #'cddr collect letter)) + (result-cdddr (loop for letter in letters by #'cdddr collect letter))) + (assert-equal ____ result-in) + (assert-equal ____ result-in-cdr) + (assert-equal ____ result-in-cddr) + (assert-equal ____ result-in-cdddr))) + +(define-test loop-across + ;; LOOP can iterate over a vector with the ACROSS keyword. + (let* ((vector (make-array '(5) :initial-contents '(0 1 2 3 4))) + (result (loop for number across vector collect number))) + (assert-equal ____ result))) + +(define-test loop-over-2d-array + (let ((array (make-array '(3 2) :initial-contents '((0 1) (2 3) (4 5))))) + ;; LOOP can be combined with ROW-MAJOR-AREF to iterate over the contents of + ;; a multidimensional array. + (let* ((result (loop for i from 0 below (array-total-size array) + collect (row-major-aref my-array i)))) + (assert-equal ____ result)) + ;; It is always possible to resort to nested loops. + (let* ((result (loop with max-i = (array-dimension array 0) + for i from 0 below max-i + collect (loop with max-j = (array-dimension array 1) + for j from 0 below max-j + collect (expt (aref my-array i j) 2))))) + (assert-equal ____ result)))) + +(define-test loop-hash-table + (let ((book-heroes (make-hash-table :test 'equal))) + (setf (gethash "The Hobbit" book-heroes) "Bilbo" + (gethash "Where The Wild Things Are" book-heroes) "Max" + (gethash "The Wizard Of Oz" book-heroes) "Dorothy" + (gethash "The Great Gatsby" book-heroes) "James Gatz") + ;; LOOP can iterate over hash tables. + (let (pairs-in-table (loop for key being the hash-key of book-heroes + using (hash-value value) + collect (list key value))) (assert-equal ____ (length pairs-in-table)) - (true-or-false? ____ (find '("The Hobbit" "Bilbo") pairs-in-table :test #'equal)))) - - -(define-test test-value-accumulation-forms - (let ((loop-1 - (loop for x in '(1 2 4 8 16) - collect x into collected - count x into counted - sum x into summed - maximize x into maximized - minimize x into minimized - finally (return (list collected counted summed maximized minimized))))) - (destructuring-bind (col count sum max min) loop-1 - (assert-equal col ____) - (assert-equal count ____) - (assert-equal sum ____) - (assert-equal max ____) - (assert-equal min ____)))) - - -(define-test test-destructuring-bind - (let* ((count 0) - (result (loop for (a b) in '((1 9) (2 8) (3 7) (4 6)) - do (setf count (+ 1 count)) - collect (+ a b)))) - (assert-equal ____ count) - (assert-equal ____ result))) - - -(define-test test-conditional-execution - (let ((loop-return - (loop for x in '(1 1 2 3 5 8 13) - when (evenp x) sum x))) - (assert-equal loop-return ____))) - - -(defun greater-than-10-p (x) - (> x 10)) - -(define-test test-conditional-with-defun - (let ((loop-return - (loop for x in '(1 1 2 3 5 8 13) - when (greater-than-10-p x) sum x))) - (assert-equal loop-return ____))) - - -(define-test test-conditional-with-lambda - (let ((loop-return - (loop for x in '(1 1 2 3 5 8 13) - when ((lambda (z) (equal 1 (mod z 3))) x) sum x))) - (assert-equal loop-return ____))) \ No newline at end of file + (true-or-false? ____ (find '("The Hobbit" "Bilbo") pairs-in-table + :test #'equal))))) + +(define-test loop-statistics + ;; LOOP can perform basics statistics on the collected elements. + (let ((result (loop for x in '(1 2 4 8 16 32) + collect x into collected + count x into counted + sum x into summed + maximize x into maximized + minimize x into minimized + finally (return (list collected counted summed + maximized minimized))))) + (destructuring-bind (collected counted summed maximized minimized) result + (assert-equal ____ collected) + (assert-equal ____ counted) + (assert-equal ____ summed) + (assert-equal ____ maximized) + (assert-equal ____ minimized)))) + +(define-test loop-destructuring + ;; LOOP can bind multiple variables on each iteration step. + (let* ((count 0) + (result (loop for (a b) in '((1 9) (2 8) (3 7) (4 6)) + do (incf count) + collect (+ a b)))) + (assert-equal ____ count) + (assert-equal ____ result))) + +(define-test conditional-execution + (let ((numbers '(1 1 2 3 5 8 13 21))) + ;; LOOP can execute some actions conditionally. + (let ((result (loop for x in numbers + when (evenp x) sum x))) + (assert-equal ____ result)) + (let ((result (loop for x in numbers + unless (evenp x) sum x))) + (assert-equal ____ result)) + (flet ((greater-than-10-p (x) (> x 10))) + (let ((result (loop for x in numbers + when (greater-than-10-p 10) sum x))) + (assert-equal ____ result))))) diff --git a/koans/mapcar-and-reduce.lisp b/koans/mapcar-and-reduce.lisp index 260f9069..4df282a6 100644 --- a/koans/mapcar-and-reduce.lisp +++ b/koans/mapcar-and-reduce.lisp @@ -1,82 +1,97 @@ -;; 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. +;;; 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. -(define-test test-mapcar-basics - "We can apply a function to each member - of a list using mapcar." - (defun times-two (x) (* x 2)) - (assert-equal ____ (mapcar #'times-two '(1 2 3))) - (assert-equal ____ (mapcar #'first '((3 2 1) - ("little" "small" "tiny") - ("pigs" "hogs" "swine"))))) +;;; Lisp supports several functional alternatives to imperative iteration. +(define-test mapcar + (let ((numbers '(1 2 3 4 5 6))) + ;; Inside MAPCAR, he function 1+ will be applied to each element of NUMBERS. + ;; A new list will be collected from the results. + (assert-equal '(2 3 4 5 6 7) (mapcar #'1+ numbers)) + (assert-equal ____ (mapcar #'- numbers)) + (assert-equal ____ (mapcar #'list numbers)) + (assert-equal ____ (mapcar #'evenp numbers)) + (assert-equal ____ (mapcar #'numberp numbers)) + (assert-equal ____ (mapcar #'stringp numbers)) + ;; MAPCAR can work on multiple lists. The function will receive one argument + ;; from each list. + (let (other-numbers '(4 8 15 16 23 42)) + (assert-equal ____ (mapcar #'+ numbers other-numbers)) + (assert-equal ____ (mapcar #'* numbers other-numbers)) + ;; The function MOD performs modulo division. + (assert-equal ____ (mapcar #'mod other-numbers numbers))))) -(define-test test-mapcar-multiple-lists - "The mapcar function can be applied to - more than one list. It applies a function - to successive elements of the lists." - (assert-equal ____ (mapcar #'* '(1 2 3) '(4 5 6))) - (assert-equal ____ (mapcar #'list '("lisp" "are") '("koans" "fun")))) +(define-test mapcar-lambda + ;; MAPCAR is often used with anonymous functions. + (let ((numbers '(8 21 152 37 403 14 7 -34))) + (assert-equal ____ (mapcar (lambda (x) (mod x 10)) numbers))) + (let ((strings '("Mary had a little lamb" + "Old McDonald had a farm" + "Happy birthday to you"))) + (assert-equal ____ (mapcar (lambda (x) (subseq x 4 12)) strings)))) +(define-test map + ;; MAP is a variant of MAPCAR that works on any sequences. + ;; It allows to specify the type of the resulting sequence. + (let ((string "lorem ipsum")) + (assert-equal ____ (map 'string #'char-upcase string)) + (assert-equal ____ (map 'list #'char-upcase string)) + ;; Not all vectors containing characters are strings. + (assert-equal ____ (map '(vector t) #'char-upcase string)))) -(define-test test-transpose-using-mapcar - "Replace the usage of WRONG-FUNCTION in 'transpose' with the - correct lisp function (don't forget the #')." - (defun WRONG-FUNCTION-1 (&rest rest) '()) - (defun transpose (L) (apply #'mapcar (cons #'WRONG-FUNCTION-1 L))) - (assert-equal '((1 4 7) - (2 5 8) - (3 6 9)) - (transpose '((1 2 3) - (4 5 6) - (7 8 9)))) - (assert-equal '(("these" "pretzels" "are") - ("making" "me" "thirsty")) - (transpose '(("these" "making") - ("pretzels" "me") - ("are" "thirsty"))))) +(define-test transposition + ;; MAPCAR gives the function as many arguments as there are lists. + (flet ((transpose (lists) (apply #'mapcar ____ lists))) + (let ((list '((1 2 3) + (4 5 6) + (7 8 9))) + (transposed-list '((1 4 7) + (2 5 8) + (3 6 9))))) + (assert-equal transposed-list (transpose list)) + (assert-equal ____ (transpose (transpose list)))) + (assert-equal ____ (transpose '(("these" "making") + ("pretzels" "me") + ("are" "thirsty"))))) +(define-test reduce + ;; The function REDUCE combines the elements of a list by applying a binary + ;; function to the elements of a sequence from left to right. + (assert-equal 15 (reduce #'+ '(1 2 3 4 5))) + (assert-equal ____ (reduce #'+ '(1 2 3 4))) + (assert-equal ____ (reduce #'expt '(1 2 3 4 5)))) -(define-test test-reduce-basics - "The reduce function combines the elements - of a list, from left to right, by applying - a binary function to the list elements." - (assert-equal ___ (reduce #'+ '(1 2 3 4))) - (assert-equal ___ (reduce #'expt '(2 3 2)))) +(define-test reduce-from-end + ;; The :FROM-END keyword argument can be used to reduce from right to left. + (let ((numbers '(1 2 3 4 5))) + (assert-equal ____ (reduce #'cons numbers)) + (assert-equal ____ (reduce #'cons numbers :from-end t))) + (let ((numbers '(2 3 2))) + (assert-equal ____ (reduce #'expt numbers)) + (assert-equal ____ (reduce #'expt numbers :from-end t)))) +(define-test reduce-initial-value + ;; :INITIAL-VALUE can supply the initial value for the reduction. + (let ((numbers '(1 2 3 4 5))) + (assert-equal ____ (reduce #'* numbers)) + (assert-equal ____ (reduce #'* numbers :initial-value 0)) + (assert-equal ____ (reduce #'* numbers :initial-value -1)))) -(define-test test-reduce-right-to-left - "The keyword :from-end allows us to apply - reduce from right to left." - (assert-equal ___ (reduce #'+ '(1 2 3 4) :from-end t)) - (assert-equal ___ (reduce #'expt '(2 3 2) :from-end t))) - - -(define-test test-reduce-with-initial-value - "We can supply an initial value to reduce." - (assert-equal ___ (reduce #'expt '(10 21 34 43) :initial-value 1)) - (assert-equal ___ (reduce #'expt '(10 21 34 43) :initial-value 0))) - - -(defun WRONG-FUNCTION-2 (a b) (a)) -(defun WRONG-FUNCTION-3 (a b) (a)) - -(define-test test-mapcar-and-reduce - "mapcar and reduce are a powerful combination. - insert the correct function names, instead of WRONG-FUNCTION-X - to define an inner product." - (defun inner (x y) - (reduce #'WRONG-FUNCTION-2 (mapcar #'WRONG-FUNCTION-3 x y))) - (assert-equal 32 (inner '(1 2 3) '(4 5 6))) - (assert-equal 310 (inner '(10 20 30) '(4 3 7)))) +(define-test inner-product + ;; MAPCAR and REDUCE are powerful when used together. + ;; Fill in the blanks to produce a local function that computes an inner + ;; product of two vectors. + (flet ((inner-product (x y) (reduce ____ (mapcar ____ x y)))) + (assert-equal 32 (inner-product '(1 2 3) '(4 5 6))) + (assert-equal 310 (inner-product '(10 20 30) '(4 3 7))))) diff --git a/koans/scoring-project.lisp b/koans/scoring-project.lisp index e4a0f785..33aea48a 100644 --- a/koans/scoring-project.lisp +++ b/koans/scoring-project.lisp @@ -1,85 +1,82 @@ -;; 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. - - -;;;;;;;;;;;;;; -;; GREED !! ;; -;;;;;;;;;;;;;; - - -;; Modified from Ruby Koans: about_scoring_project.rb - -; *Greed* is a dice game where you roll up to five dice to accumulate -; points. The following "score" function will be used to calculate the -; score of a single roll of the dice. -; -; A greed roll is scored as follows: -; -; * A set of three ones is 1000 points -; -; * A set of three numbers (other than ones) is worth 100 times the -; number. (e.g. three fives is 500 points). -; -; * A one (that is not part of a set of three) is worth 100 points. -; -; * A five (that is not part of a set of three) is worth 50 points. -; -; * Everything else is worth 0 points. -; -; -; Examples: -; -; (score '(1 1 1 5 1)) => 1150 points -; (score '(2 3 4 6 2)) => 0 points -; (score '(3 4 5 3 3)) => 350 points -; (score '(1 5 1 2 4)) => 250 points -; -; More scoring examples are given in the tests below: -; -; Your goal is to write the score method. - -(defun score (dice) - ; You need to write this method -) - -(define-test test-score-of-an-empty-list-is-zero - (assert-equal 0 (score nil))) - -(define-test test-score-of-a-single-roll-of-5-is-50 - (assert-equal 50 (score '(5)))) - - -(define-test test-score-of-a-single-roll-of-1-is-100 - (assert-equal 100 (score '(1)))) - -(define-test test-score-of-multiple-1s-and-5s-is-the-sum-of-individual-scores - (assert-equal 300 (score '(1 5 5 1)))) - -(define-test test-score-of-single-2s-3s-4s-and-6s-are-zero - (assert-equal 0 (score '(2 3 4 6)))) - - -(define-test test-score-of-a-triple-1-is-1000 - (assert-equal 1000 (score '(1 1 1)))) - -(define-test test-score-of-other-triples-is-100x - (assert-equal 200 (score '(2 2 2))) - (assert-equal 300 (score '(3 3 3))) - (assert-equal 400 (score '(4 4 4))) - (assert-equal 500 (score '(5 5 5))) - (assert-equal 600 (score '(6 6 6)))) - -(define-test test-score-of-mixed-is-sum - (assert-equal 250 (score '(2 5 2 2 3))) - (assert-equal 550 (score '(5 5 5 5)))) +;;; 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. + +;;; Greed is a dice game played among 2 or more players, using 5 +;;; six-sided dice. +;;; +;;; Each player takes a turn consisting of one or more rolls of the dice. +;;; On the first roll of the game, a player rolls all five dice which are +;;; scored according to the following: +;;; +;;; Three 1's => 1000 points +;;; Three 6's => 600 points +;;; Three 5's => 500 points +;;; Three 4's => 400 points +;;; Three 3's => 300 points +;;; Three 2's => 200 points +;;; One 1 => 100 points +;;; One 5 => 50 points +;;; +;;; A single die can only be counted once in each roll. For example, +;;; a "5" can only count as part of a triplet (contributing to the 500 +;;; points) or as a single 50 points, but not both in the same roll. +;;; +;;; Example Scoring +;;; +;;; Throw Score +;;; --------- ------------------ +;;; 5 1 3 4 1 50 + 2 * 100 = 250 +;;; 1 1 1 3 1 1000 + 100 = 1100 +;;; 2 4 4 5 4 400 + 50 = 450 +;;; +;;; The dice not contributing to the score are called the non-scoring +;;; dice. "3" and "4" are non-scoring dice in the first example. "3" is +;;; a non-scoring die in the second, and "2" is a non-score die in the +;;; final example. +;;; +;;; More scoring examples are given in the tests below. +;;; +;;; Your goal is to write the scoring function for Greed. + +(defun score (&rest dice) + ____) + +(define-test score-of-an-empty-list-is-zero + (assert-equal 0 (score))) + +(define-test score-of-a-single-roll-of-5-is-50 + (assert-equal 50 (score 5))) + +(define-test score-of-a-single-roll-of-1-is-100 + (assert-equal 100 (score 1))) + +(define-test score-of-multiple-1s-and-5s-is-the-sum-of-individual-scores + (assert-equal 300 (score 1 5 5 1))) + +(define-test score-of-single-2s-3s-4s-and-6s-are-zero + (assert-equal 0 (score 2 3 4 6))) + +(define-test score-of-a-triple-1-is-1000 + (assert-equal 1000 (score 1 1 1))) + +(define-test score-of-other-triples-is-100x + (assert-equal 200 (score 2 2 2)) + (assert-equal 300 (score 3 3 3)) + (assert-equal 400 (score 4 4 4)) + (assert-equal 500 (score 5 5 5)) + (assert-equal 600 (score 6 6 6))) + +(define-test score-of-mixed-is-sum + (assert-equal 250 (score 2 5 2 2 3)) + (assert-equal 550 (score 5 5 5 5))) diff --git a/koans/type-checking.lisp b/koans/type-checking.lisp index c8be8003..aec9010f 100644 --- a/koans/type-checking.lisp +++ b/koans/type-checking.lisp @@ -1,86 +1,86 @@ -;; 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. +;;; 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. ;; Common lisp types have hierarchy. Any object may belong a family of types. ;; The top level type, which includes everything else, is 't' (define-test test-check-some-common-types - (true-or-false? ___ (typep "hello" 'string)) - (true-or-false? ___ (typep "hello" 'array)) - (true-or-false? ___ (typep "hello" 'list)) - (true-or-false? ___ (typep "hello" '(simple-array character (5)))) + (true-or-false? ___ (typep "hello" 'string)) + (true-or-false? ___ (typep "hello" 'array)) + (true-or-false? ___ (typep "hello" 'list)) + (true-or-false? ___ (typep "hello" '(simple-array character (5)))) - (true-or-false? ___ (typep '(1 2 3) 'list)) - (true-or-false? ___ (typep 99 'integer)) - (true-or-false? ___ (typep nil 'NULL)) - (true-or-false? ___ (typep 22/7 'ratio)) - (true-or-false? ___ (typep 4.0 'float)) - (true-or-false? ___ (typep #\a 'character)) - (true-or-false? ___ (typep #'length 'function))) + (true-or-false? ___ (typep '(1 2 3) 'list)) + (true-or-false? ___ (typep 99 'integer)) + (true-or-false? ___ (typep nil 'NULL)) + (true-or-false? ___ (typep 22/7 'ratio)) + (true-or-false? ___ (typep 4.0 'float)) + (true-or-false? ___ (typep #\a 'character)) + (true-or-false? ___ (typep #'length 'function))) (define-test test-get-type-with-type-of - (assert-equal ____ (type-of ())) - (assert-equal ____ (type-of 4/6))) + (assert-equal ____ (type-of ())) + (assert-equal ____ (type-of 4/6))) (define-test test-type-sets-may-overlap - (true-or-false? ___ (typep () 'list)) - (true-or-false? ___ (typep () 'atom)) - (true-or-false? ___ (typep () 'NULL)) - (true-or-false? ___ (typep () t))) + (true-or-false? ___ (typep () 'list)) + (true-or-false? ___ (typep () 'atom)) + (true-or-false? ___ (typep () 'NULL)) + (true-or-false? ___ (typep () t))) (define-test test-integers-can-get-really-big - (true-or-false? ____ (typep 12345678901234567890123456789012 'integer)) - ;; Integers are either fixnum or bignum. - ;; The boundary between fixnum and bignum is given by the constant: - ;; most-positive-fixnum - (assert-true (typep 1234567890123456789 'fixnum)) - (assert-true (typep 12345678901234567890 'bignum)) - (true-or-false? ___ (typep most-positive-fixnum 'fixnum)) - (true-or-false? ___ (typep (+ 1 most-positive-fixnum) 'fixnum))) + (true-or-false? ____ (typep 12345678901234567890123456789012 'integer)) + ;; Integers are either fixnum or bignum. + ;; The boundary between fixnum and bignum is given by the constant: + ;; most-positive-fixnum + (assert-true (typep 1234567890123456789 'fixnum)) + (assert-true (typep 12345678901234567890 'bignum)) + (true-or-false? ___ (typep most-positive-fixnum 'fixnum)) + (true-or-false? ___ (typep (+ 1 most-positive-fixnum) 'fixnum))) (define-test test-lisp-type-system-is-hierarchy - (assert-true (typep 1 'bit)) - (assert-true (typep 1 'integer)) - (assert-true (typep 2 'integer)) - (true-or-false? ____ (subtypep 'bit 'integer)) - (true-or-false? ____ (subtypep (type-of 1) (type-of 2))) - (true-or-false? ____ (subtypep (type-of 2) (type-of 1)))) + (assert-true (typep 1 'bit)) + (assert-true (typep 1 'integer)) + (assert-true (typep 2 'integer)) + (true-or-false? ____ (subtypep 'bit 'integer)) + (true-or-false? ____ (subtypep (type-of 1) (type-of 2))) + (true-or-false? ____ (subtypep (type-of 2) (type-of 1)))) (define-test test-some-types-are-lists - (assert-true(typep (make-array 0 :element-type 'integer) '(SIMPLE-VECTOR 0))) - (true-or-false? ____ (typep (make-array '(3 3) :element-type 'integer) '(SIMPLE-ARRAY T (3 3))))) + (assert-true(typep (make-array 0 :element-type 'integer) '(SIMPLE-VECTOR 0))) + (true-or-false? ____ (typep (make-array '(3 3) :element-type 'integer) '(SIMPLE-ARRAY T (3 3))))) (define-test test-type-specifier-lists-also-have-hierarchy - (true-or-false? ____ (subtypep '(SIMPLE-ARRAY T (3 3)) '(SIMPLE-ARRAY T *))) - (true-or-false? ____ (subtypep '(vector double-float 100) '(vector * 100))) - (true-or-false? ____ (subtypep '(vector double-float 100) '(vector double-float *))) - (true-or-false? ____ (subtypep '(vector double-float 100) '(vector * *))) - (true-or-false? ____ (subtypep '(vector double-float 100) '(array number *))) - (true-or-false? ____ (subtypep '(vector double-float 100) t))) + (true-or-false? ____ (subtypep '(SIMPLE-ARRAY T (3 3)) '(SIMPLE-ARRAY T *))) + (true-or-false? ____ (subtypep '(vector double-float 100) '(vector * 100))) + (true-or-false? ____ (subtypep '(vector double-float 100) '(vector double-float *))) + (true-or-false? ____ (subtypep '(vector double-float 100) '(vector * *))) + (true-or-false? ____ (subtypep '(vector double-float 100) '(array number *))) + (true-or-false? ____ (subtypep '(vector double-float 100) t))) (define-test test-type-coersion - (assert-true (typep 0 'integer)) - (true-or-false? ___ (typep 0 'short-float)) - (true-or-false? ___ (subtypep 'integer 'short-float)) - (true-or-false? ___ (subtypep 'short-float 'integer)) - (true-or-false? ___ (typep (coerce 0 'short-float) 'short-float))) + (assert-true (typep 0 'integer)) + (true-or-false? ___ (typep 0 'short-float)) + (true-or-false? ___ (subtypep 'integer 'short-float)) + (true-or-false? ___ (subtypep 'short-float 'integer)) + (true-or-false? ___ (typep (coerce 0 'short-float) 'short-float))) (define-test test-atoms-are-anything-thats-not-a-cons @@ -92,7 +92,7 @@ (define-test test-functionp - "the functionp predicate is true iff the argument is a function" + "the functionp predicate is true iff the argument is a function" (assert-true (functionp (lambda (a b c) (+ a b c)))) (true-or-false? ___ (functionp #'make-array)) (true-or-false? ___ (functionp '(1 2 3))) @@ -100,7 +100,7 @@ (define-test test-there-are-some-other-type-predicates - ; see http://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node73.html for more. + ; see http://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node73.html for more. (true-or-false? ___ (numberp 999)) (true-or-false? ___ (listp '(9 9 9))) (true-or-false? ___ (integerp 999)) @@ -112,9 +112,9 @@ (define-test test-guess-that-type! - (let ((x ____)) - (assert-true (subtypep x '(SIMPLE-ARRAY T (* 3 *)))) - (assert-true (subtypep x '(SIMPLE-ARRAY T (5 * *)))) - (assert-true (subtypep x '(SIMPLE-ARRAY ARRAY *))) - (assert-true (typep (make-array '(5 3 9) :element-type 'STRING ) x)) - (assert-true (typep (make-array '(5 3 33) :element-type 'VECTOR ) x)))) + (let ((x ____)) + (assert-true (subtypep x '(SIMPLE-ARRAY T (* 3 *)))) + (assert-true (subtypep x '(SIMPLE-ARRAY T (5 * *)))) + (assert-true (subtypep x '(SIMPLE-ARRAY ARRAY *))) + (assert-true (typep (make-array '(5 3 9) :element-type 'STRING ) x)) + (assert-true (typep (make-array '(5 3 33) :element-type 'VECTOR ) x)))) From 17c4438652ed87f8c03d6a4475bbbdf46ddde532 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Thu, 7 May 2020 16:36:18 +0200 Subject: [PATCH 083/133] Finish type-checking koans --- koans/type-checking.lisp | 210 ++++++++++++++++++++++----------------- 1 file changed, 121 insertions(+), 89 deletions(-) diff --git a/koans/type-checking.lisp b/koans/type-checking.lisp index aec9010f..62c6c11a 100644 --- a/koans/type-checking.lisp +++ b/koans/type-checking.lisp @@ -12,109 +12,141 @@ ;;; See the License for the specific language governing permissions and ;;; limitations under the License. -;; Common lisp types have hierarchy. Any object may belong a family of types. -;; The top level type, which includes everything else, is 't' - -(define-test test-check-some-common-types - (true-or-false? ___ (typep "hello" 'string)) - (true-or-false? ___ (typep "hello" 'array)) - (true-or-false? ___ (typep "hello" 'list)) - (true-or-false? ___ (typep "hello" '(simple-array character (5)))) - - (true-or-false? ___ (typep '(1 2 3) 'list)) - (true-or-false? ___ (typep 99 'integer)) - (true-or-false? ___ (typep nil 'NULL)) - (true-or-false? ___ (typep 22/7 'ratio)) - (true-or-false? ___ (typep 4.0 'float)) - (true-or-false? ___ (typep #\a 'character)) - (true-or-false? ___ (typep #'length 'function))) - - -(define-test test-get-type-with-type-of - (assert-equal ____ (type-of ())) +;;; There is a type hierarchy in Lisp, based on the set theory. +;;; An object may belong to multiple types at the same time. +;;; Every object is of type T. No object is of type NIL. + +(define-test typep + ;; TYPEP returns true if the provided object is of the provided type. + (true-or-false? ____ (typep "hello" 'string)) + (true-or-false? ____ (typep "hello" 'array)) + (true-or-false? ____ (typep "hello" 'list)) + (true-or-false? ____ (typep "hello" '(simple-array character (5)))) + (true-or-false? ____ (typep '(1 2 3) 'list)) + (true-or-false? ____ (typep 99 'integer)) + (true-or-false? ____ (typep nil 'NULL)) + (true-or-false? ____ (typep 22/7 'ratio)) + (true-or-false? ____ (typep 4.0 'float)) + (true-or-false? ____ (typep #\a 'character)) + (true-or-false? ____ (typep #'length 'function))) + +(define-test type-of + ;; TYPE-OF returns a type specifier for the object. + (assert-equal ____ (type-of '())) (assert-equal ____ (type-of 4/6))) -(define-test test-type-sets-may-overlap - (true-or-false? ___ (typep () 'list)) - (true-or-false? ___ (typep () 'atom)) - (true-or-false? ___ (typep () 'NULL)) - (true-or-false? ___ (typep () t))) - - -(define-test test-integers-can-get-really-big - (true-or-false? ____ (typep 12345678901234567890123456789012 'integer)) - ;; Integers are either fixnum or bignum. - ;; The boundary between fixnum and bignum is given by the constant: - ;; most-positive-fixnum - (assert-true (typep 1234567890123456789 'fixnum)) - (assert-true (typep 12345678901234567890 'bignum)) - (true-or-false? ___ (typep most-positive-fixnum 'fixnum)) - (true-or-false? ___ (typep (+ 1 most-positive-fixnum) 'fixnum))) - - -(define-test test-lisp-type-system-is-hierarchy +(define-test overlapping-types + ;; Because Lisp types are mathematical sets, they are allowed to overlap. + (let ((thing '())) + (true-or-false? ____ (typep thing 'list)) + (true-or-false? ____ (typep thing 'atom)) + (true-or-false? ____ (typep thing 'null)) + (true-or-false? ____ (typep thing 't)))) + +(define-test fixnum-versus-bignum + ;; In Lisp, integers are either fixnums or bignums. Fixnums are handled more + ;; efficiently by the implementation, but some large integers can only be + ;; represented as bignums. + ;; Lisp converts between these two types on the fly. The constants + ;; MOST-NEGATIVE-FIXNUM and MOST-POSITIVE-FIXNUM describe the limits for + ;; fixnums. + (let ((integer-1 0) + (integer-2 most-positive-fixnum) + (integer-3 (1+ most-positive-fixnum)) + (integer-4 (1- most-negative-fixnum))) + (true-or-false? ____ (typep integer-1 'fixunm)) + (true-or-false? ____ (typep integer-1 'bignum)) + (true-or-false? ____ (typep integer-2 'fixnum)) + (true-or-false? ____ (typep integer-2 'bignum)) + (true-or-false? ____ (typep integer-3 'fixnum)) + (true-or-false? ____ (typep integer-3 'bignum)) + (true-or-false? ____ (typep integer-4 'fixnum)) + (true-or-false? ____ (typep integer-4 'bignum)) + ;; Regardless of whether an integer is a fixnum or a bignum, it is still + ;; an integer. + (true-or-false? ____ (typep integer-1 'integer)) + (true-or-false? ____ (typep integer-2 'integer)) + (true-or-false? ____ (typep integer-3 'integer)) + (true-or-false? ____ (typep integer-4 'integer)))) + +(define-test subtypep (assert-true (typep 1 'bit)) + (assert-true (typep 1 'fixnum)) (assert-true (typep 1 'integer)) (assert-true (typep 2 'integer)) + ;; The function SUBTYPEP attempts to answer whether one type specifier + ;; represents a subtype of the other type specifier. (true-or-false? ____ (subtypep 'bit 'integer)) (true-or-false? ____ (subtypep (type-of 1) (type-of 2))) (true-or-false? ____ (subtypep (type-of 2) (type-of 1)))) - -(define-test test-some-types-are-lists - (assert-true(typep (make-array 0 :element-type 'integer) '(SIMPLE-VECTOR 0))) - (true-or-false? ____ (typep (make-array '(3 3) :element-type 'integer) '(SIMPLE-ARRAY T (3 3))))) - - -(define-test test-type-specifier-lists-also-have-hierarchy - (true-or-false? ____ (subtypep '(SIMPLE-ARRAY T (3 3)) '(SIMPLE-ARRAY T *))) +(define-test list-type-specifiers + ;; Some type specifiers are lists; this way, they carry more information than + ;; type specifiers which are symbols. + (assert-true (typep (make-array 0) '(vector * 0))) + (assert-true (typep (make-array 42) '(vector * 42))) + (assert-true (typep (make-array 42 :element-type 'bit) '(vector bit 42))) + (assert-true (typep (make-array '(4 2)) '(array * (4 2)))) + (true-or-false? ____ (typep (make-array '(3 3)) '(simple-array t (3 3)))) + (true-or-false? ____ (typep (make-array '(3 2 1)) '(simple-array t (1 2 3))))) + +(define-test list-type-specifiers-hierarchy + ;; Type specifiers that are lists also follow hierarchy. + (true-or-false? ____ (subtypep '(simple-array t (3 3)) '(simple-array t *))) (true-or-false? ____ (subtypep '(vector double-float 100) '(vector * 100))) (true-or-false? ____ (subtypep '(vector double-float 100) '(vector double-float *))) (true-or-false? ____ (subtypep '(vector double-float 100) '(vector * *))) (true-or-false? ____ (subtypep '(vector double-float 100) '(array number *))) (true-or-false? ____ (subtypep '(vector double-float 100) t))) - -(define-test test-type-coersion +(define-test type-coercion (assert-true (typep 0 'integer)) - (true-or-false? ___ (typep 0 'short-float)) - (true-or-false? ___ (subtypep 'integer 'short-float)) - (true-or-false? ___ (subtypep 'short-float 'integer)) - (true-or-false? ___ (typep (coerce 0 'short-float) 'short-float))) - - -(define-test test-atoms-are-anything-thats-not-a-cons - (true-or-false? ___ (atom 4)) - (true-or-false? ___ (atom '(1 2 3 4))) - (true-or-false? ___ (atom 'some-unbound-name)) - (assert-true (typep (make-array '(4 4)) '(SIMPLE-ARRAY * *))) - (true-or-false? ___ (atom (make-array '(4 4))))) - - -(define-test test-functionp - "the functionp predicate is true iff the argument is a function" + (true-or-false? ____ (typep 0 'short-float)) + (true-or-false? ____ (subtypep 'integer 'short-float)) + (true-or-false? ____ (subtypep 'short-float 'integer)) + ;; The function COERCE makes it possible to convert values between some + ;; standard types. + (true-or-false? ____ (typep (coerce 0 'short-float) 'short-float))) + +(define-test atoms-are-anything-thats-not-a-cons + ;; In Lisp, an atom is anything that is not a cons cell. The function ATOM + ;; returns true if its object is an atom. + (true-or-false? ____ (atom 4)) + (true-or-false? ____ (atom '(1 2 3 4))) + (true-or-false? ____ (atom '(:foo . :bar))) + (true-or-false? ____ (atom 'symbol)) + (true-or-false? ____ (atom :keyword)) + (true-or-false? ____ (atom #(1 2 3 4 5))) + (true-or-false? ____ (atom #\A)) + (true-or-false? ____ (atom "string")) + (true-or-false? ____ (atom (make-array '(4 4))))) + +(define-test functionp + ;; The function FUNCTIONP returns true if its arguments is a function. (assert-true (functionp (lambda (a b c) (+ a b c)))) - (true-or-false? ___ (functionp #'make-array)) - (true-or-false? ___ (functionp '(1 2 3))) - (true-or-false? ___ (functionp t))) - - -(define-test test-there-are-some-other-type-predicates - ; see http://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node73.html for more. - (true-or-false? ___ (numberp 999)) - (true-or-false? ___ (listp '(9 9 9))) - (true-or-false? ___ (integerp 999)) - (true-or-false? ___ (rationalp 9/99)) - (true-or-false? ___ (floatp 9.99)) - (true-or-false? ___ (stringp "nine nine nine")) - (true-or-false? ___ (characterp #\9)) - (true-or-false? ___ (bit-vector-p #*01001))) - - -(define-test test-guess-that-type! - (let ((x ____)) - (assert-true (subtypep x '(SIMPLE-ARRAY T (* 3 *)))) - (assert-true (subtypep x '(SIMPLE-ARRAY T (5 * *)))) - (assert-true (subtypep x '(SIMPLE-ARRAY ARRAY *))) - (assert-true (typep (make-array '(5 3 9) :element-type 'STRING ) x)) - (assert-true (typep (make-array '(5 3 33) :element-type 'VECTOR ) x)))) + (true-or-false? ____ (functionp #'make-array)) + (true-or-false? ____ (functionp 'make-array)) + (true-or-false? ____ (functionp (lambda (x) (* x x)))) + (true-or-false? ____ (functionp '(lambda (x) (* x x)))) + (true-or-false? ____ (functionp '(1 2 3))) + (true-or-false? ____ (functionp t))) + +(define-test other-type-predicates + ;; Lisp defines multiple type predicates for standard types.. + (true-or-false? ____ (numberp 999)) + (true-or-false? ____ (listp '(9 9 9))) + (true-or-false? ____ (integerp 999)) + (true-or-false? ____ (rationalp 9/99)) + (true-or-false? ____ (floatp 9.99)) + (true-or-false? ____ (stringp "nine nine nine")) + (true-or-false? ____ (characterp #\9)) + (true-or-false? ____ (bit-vector-p #*01001))) + +(define-test guess-that-type + ;; Fill in the blank with a type specifier that satisfies the following tests. + (let ((type ____)) + (assert-true (subtypep type '(simple-array t (* 3 *)))) + (assert-true (subtypep type '(simple-array t (5 * *)))) + (assert-true (subtypep type '(simple-array array *))) + (assert-true (typep (make-array '(5 3 9) :element-type 'string) type)) + (assert-true (typep (make-array '(5 3 33) :element-type 'vector) type)))) From e970d5a3c957b4a420d89d1488c5e673432982c0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Fri, 8 May 2020 14:03:25 +0200 Subject: [PATCH 084/133] Add CLOS --- koans/clos.lisp | 408 +++++++++++++++++++++++++++--------------------- 1 file changed, 233 insertions(+), 175 deletions(-) diff --git a/koans/clos.lisp b/koans/clos.lisp index 8e206983..e54f8a85 100644 --- a/koans/clos.lisp +++ b/koans/clos.lisp @@ -1,177 +1,235 @@ -;; 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. - - -;; CLOS stands for Common Lisp Object System. -;; CLOS is common lisps' object oriented framework. - -(defclass racecar () (color speed)) - -(define-test test-defclass - (let ((car-1 (make-instance 'racecar)) - (car-2 (make-instance 'racecar))) - (setf (slot-value car-1 'color) :red) - (setf (slot-value car-1 'speed) 220) - (setf (slot-value car-2 'color) :blue) - (setf (slot-value car-2 'speed) 240) - (assert-equal ____ (slot-value car-1 'color)) - (assert-equal ____ (slot-value car-2 'speed)))) - -;; CLOS provides functionality for creating getters / setters -;; for defined objects +;;; 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. + +;;; CLOS is a shorthand for Common Lisp Object System. + +(defclass racecar () + ;; A class definition lists all the slots of every instance. + (color speed)) + +(define-test defclass + ;; Class instances are constructed via MAKE-INSTANCE. + (let ((car-1 (make-instance 'racecar)) + (car-2 (make-instance 'racecar))) + ;; Slot values can be set via SLOT-VALUE. + (setf (slot-value car-1 'color) :red) + (setf (slot-value car-1 'speed) 220) + (setf (slot-value car-2 'color) :blue) + (setf (slot-value car-2 'speed) 240) + (assert-equal ____ (slot-value car-1 'color)) + (assert-equal ____ (slot-value car-2 'speed)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defclass spaceship () - ((color :reader get-color :writer set-color) - (speed :reader get-speed :writer set-speed))) - -(define-test test-clos-getters-and-setters - (let ((ship-1 (make-instance 'spaceship))) - (set-color :orange ship-1) - (assert-equal ____ (get-color ship-1)) - (set-speed 1000 ship-1) - (assert-equal ____ (get-speed ship-1)))) - -;; CLOS also provides functionality to create accessors -;; to object data. - -;; stores a value, and a counter which tallies accesses, read or write, -;; to that value -(defclass value-with-access-counter () - ((value :reader get-value :writer set-value :initform 0) - (access-count :reader how-many-value-queries :initform 0))) - -(defmethod get-value ((object value-with-access-counter)) - (incf (slot-value object 'access-count)) - (slot-value object 'value)) - -(defmethod set-value (new-value (object value-with-access-counter)) - (incf (slot-value object 'access-count)) - (setf (slot-value object 'value) new-value)) - -(define-test test-access-counter - (let ((x (make-instance 'value-with-access-counter))) - ; check that no one has ever looked at the x value yet. - (assert-equal ____ (how-many-value-queries x)) - ; check that the default value is zero. - (assert-equal ___ (get-value x)) - ; now that we've looked at it, there is a single access. - (assert-equal ___ (how-many-value-queries x)) - ; check that we can set and read the value - (set-value 33 x) - (assert-equal 33 (get-value x)) - (assert-equal ___ (how-many-value-queries x)))) - - -; countdowner has a value which goes down every time you look at it -; and returns "bang" when it hits zero. -(defclass countdowner () - ((value :initform 4))) - -;; Write the get-value for the countdowner -;; to satisfy the test-countdowner tests. -;; you may be interested in the 'decf function. -(defmethod get-value ((object countdowner)) - :WRITE-ME) - - -(define-test test-countdowner - (let ((c (make-instance 'countdowner))) - (assert-equal 3 (get-value c)) - (assert-equal 2 (get-value c)) - (assert-equal 1 (get-value c)) - (assert-equal "bang" (get-value c)) - (assert-equal "bang" (get-value c)))) - - -;; Classes can inherit data and methods from other classes. -;; Here, the specific CIRCLE class extends the generic SHAPE class -(defclass shape () - ((kind :reader get-kind :writer set-kind :initform :default-shape-kind) - (pos :reader get-pos :writer set-pos :initform '(0 0)))) - -(defclass circle (shape) - ((radius :reader get-radius :writer set-radius :initform 0))) - -(define-test test-inheritance - (let ((circle-1 (make-instance 'circle)) - (shape-1 (make-instance 'shape))) - (assert-equal ____ (type-of shape-1)) - (assert-equal ____ (type-of circle-1)) - (true-or-false? ____ (typep circle-1 'circle)) - (true-or-false? ____ (typep circle-1 'shape)) - (set-kind :circle circle-1) - (set-pos '(3 4) circle-1) - (set-radius 5 circle-1) - (assert-equal ____ (get-pos circle-1)) - (assert-equal ____ (get-radius circle-1)))) - -;; Classes may also inherit from more than one base class. -;; This is known as multiple inheritance. - -;; Color holds an rgb triplet and a transparency alpha value. -;; The RGB stands for the amount of red, green, and blue. -;; the alpha (transparency) value is 0 for completely opaque. -;; Note that color also has a kind, like shape. - -(defclass color () - ((rgb :reader get-rgb :writer set-rgb :initform '(0 0 0)) - (alpha :reader get-alpha :writer set-alpha :initform 0) - (kind :reader get-kind :writer set-kind :initform :default-color-kind))) - -;; The COLORED-CIRCLE class extends both CIRCLE and COLOR. -;; Of particular interest is which "kind" slot will COLORED-CIRCLE get, -;; since both CIRCLE and COLOR provide the "kind" slot. - -(defclass colored-circle (color circle) ()) -(defclass circled-color (circle color) ()) - -(define-test test-multiple-inheritance - (let ((my-colored-circle (make-instance 'colored-circle)) - (my-circled-color (make-instance 'circled-color))) - (assert-equal ____ (get-kind my-colored-circle)) - (assert-equal ____ (get-kind my-circled-color)))) - - -(defvar *last-kind-accessor* nil) - -(defmethod get-kind ((object shape)) - (setf *last-kind-accessor* :shape) - (slot-value object 'kind)) - -(defmethod get-kind ((object circle)) - (setf *last-kind-accessor* :circle) - (slot-value object 'kind)) - -(defmethod get-kind ((object color)) - (setf *last-kind-accessor* :color) - (slot-value object 'kind)) - -;; Precedence order is similarly a depth first search for methods. - -(define-test test-multiple-inheritance-method-order - (let ((my-colored-circle (make-instance 'colored-circle)) - (my-circled-color (make-instance 'circled-color)) - (my-shape (make-instance 'shape)) - (my-circle (make-instance 'circle)) - (my-color (make-instance 'color))) - (get-kind my-shape) - (assert-equal ____ *last-kind-accessor*) - (get-kind my-circle) - (assert-equal ____ *last-kind-accessor*) - (get-kind my-color) - (assert-equal ____ *last-kind-accessor*) - (get-kind my-colored-circle) - (assert-equal ____ *last-kind-accessor*) - (get-kind my-circled-color) - (assert-equal ____ *last-kind-accessor*))) + ;; It is possible to define reader, writer, and accessor functions for slots. + ((color :reader color :writer (setf color)) + (speed :accessor color))) + +;;; Specifying a reader function named COLOR is equivalent to +;;; (DEFMETHOD COLOR ((OBJECT SPACECSHIP)) ...) +;;; Specifying a writer function named (SETF COLOR) is equivalent to +;;; (DEFMETHOD (SETF COLOR) (NEW-VALUE (OBJECT SPACECSHIP)) ...) +;;; Specifying an accessor function performs both of the above. + +(define-test accessors + (let ((ship (make-instance 'spaceship))) + (setf (color ship) :orange + (speed ship) 1000) + (assert-equal ____ (color ship)) + (assert-equal ____ (speed ship)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass bike () + ;; It is also possible to define initial arguments for slots. + ((color :reader color :initarg :color) + (speed :reader color :initarg :color))) + +(define-test initargs + (let ((bike (make-instance 'bike :color :blue :speed 30))) + (assert-equal ____ (color bike)) + (assert-equal ____ (speed bike)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass access-counter () + ((value :reader value :initform :value) + (access-count :reader access-count :initform 0))) + +;;; The generated reader, writer, and accessor functions are generic functions. +;;; 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. + +(defmethod value :after ((object access-counter)) + (incf (slot-value object 'access-count))) + +(defmethod (setf value) :after ((object access-counter)) + (incf (slot-value object 'access-count))) + +(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)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(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 :value))) + +;;; In addition to :BEFORE and :AFTER methods is also possible to write :AROUND +;;; methods, whose code executes around the primary method. In such context, it +;;; is possible to call the primary method via CALL-NEXT-METHOD. + +(defmethod remaining-time :around ((object countdown)) + (let ((value (call-next-method))) + (if (<= 0 value) + ;; DECF is similar to INCF. It decreases the value stored in the place + ;; and returns the decreased value. + (decf value) + :bang))) + +(define-test countdown + (let ((countdown (make-instance 'countdown :value 4))) + (assert-equal 3 (remaining-time countdown)) + (assert-equal 2 (remaining-time countdown)) + (assert-equal 1 (remaining-time countdown)) + (assert-equal :bang (remaining-time countdown)) + (assert-equal :bang (remaining-time countdown)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Lisp classes can inherit from one another. + +(defclass person () + ((name :initarg :name :accessor person-name))) + +(defclass lisp-programmer (person) + ((favorite-lisp-implementation :initarg :favorite-lisp-implementation + :accessor favorite-lisp-implementation))) + +(defclass c-programmer (person) + (favorite-c-compiler :initarg :favorite-c-compiler + :accessor favorite-c-compiler)) + +(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 :llvm))) + (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)))) + +;;; This includes multiple inheritance. + +(defclass clisp-programmer (lisp-programmer c-programmer) ()) + +(define-test multiple-inheritance + (let ((zenon (make-instance 'clisp-programmer + :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 'embeddable-common-lisp-programmer)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Multiple inheritance makes it possible to work with mixin classes. + +(defclass greeting-mixin () + ((greeted-people :accessor greeted-people :initform '()))) + +(defgeneric greet (greeter greetee)) + +(defmethod greet ((object greeting-mixin) name) + ;; PUSHNEW is similar to PUSH, but it does not modify the place if the object + ;; we want to push is already found on the list in the place. + (pushnew name (greeted-people object) :test #'equal) + (format nil "Hello, ~A." name)) + +(defclass chatbot () + ((version :reader version :initarg :version))) + +(defclass greeting-chatbot (greeting-mixin chatbot) ()) + +(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)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass american (person) ()) + +(defclass italian (person) ()) + +(defgeneric stereotypical-food (person) + ;; We can use :METHOD options to DEFGENERIC to define methods for that + ;; function. + (:method ((person italian)) :pasta) + (:method ((person american)) :burger)) + +;;; When methods or slot definitions of superclasses overlap with each other, +;;; the order of superclasses is used to resolve the conflict. + +(defclass stereotypical-person (american italian) ()) + +(defclass another-stereotypical-person (italian american) ()) + +(define-test stereotypes + (let ((james (make-instance 'american)) + (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)))) From 50d46b09f293a450b0387c01758833d96af735bf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Fri, 8 May 2020 15:35:17 +0200 Subject: [PATCH 085/133] Fix CLOS and method combinations --- koans/clos.lisp | 63 +----- koans/std-method-comb.lisp | 393 +++++++++++++++++++++---------------- 2 files changed, 220 insertions(+), 236 deletions(-) diff --git a/koans/clos.lisp b/koans/clos.lisp index e54f8a85..5e106abb 100644 --- a/koans/clos.lisp +++ b/koans/clos.lisp @@ -64,66 +64,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defclass access-counter () - ((value :reader value :initform :value) - (access-count :reader access-count :initform 0))) - -;;; The generated reader, writer, and accessor functions are generic functions. -;;; 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. - -(defmethod value :after ((object access-counter)) - (incf (slot-value object 'access-count))) - -(defmethod (setf value) :after ((object access-counter)) - (incf (slot-value object 'access-count))) - -(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)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(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 :value))) - -;;; In addition to :BEFORE and :AFTER methods is also possible to write :AROUND -;;; methods, whose code executes around the primary method. In such context, it -;;; is possible to call the primary method via CALL-NEXT-METHOD. - -(defmethod remaining-time :around ((object countdown)) - (let ((value (call-next-method))) - (if (<= 0 value) - ;; DECF is similar to INCF. It decreases the value stored in the place - ;; and returns the decreased value. - (decf value) - :bang))) - -(define-test countdown - (let ((countdown (make-instance 'countdown :value 4))) - (assert-equal 3 (remaining-time countdown)) - (assert-equal 2 (remaining-time countdown)) - (assert-equal 1 (remaining-time countdown)) - (assert-equal :bang (remaining-time countdown)) - (assert-equal :bang (remaining-time countdown)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;;; Lisp classes can inherit from one another. (defclass person () @@ -212,8 +152,7 @@ (defclass italian (person) ()) (defgeneric stereotypical-food (person) - ;; We can use :METHOD options to DEFGENERIC to define methods for that - ;; function. + ;; The :METHOD option in DEFGENERIC is an alternative to DEFMETHOD. (:method ((person italian)) :pasta) (:method ((person american)) :burger)) diff --git a/koans/std-method-comb.lisp b/koans/std-method-comb.lisp index 428678f8..f2e7310b 100644 --- a/koans/std-method-comb.lisp +++ b/koans/std-method-comb.lisp @@ -1,174 +1,219 @@ -;; 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. - -;; In CLOS we have primary methods and auxiliary methods. -;; By default, methods are primary. -;; An auxiliary method is a method with a qualifier -;; `:before', `:after' or `:around'. -;; -;; The order of evaluation is as follows: -;; First call :before methods from most specific to least specific. -;; Second call the most specific primary method. -;; Finaly call :after methods from least specific to most specific. -;; -;; In other words: -;; The :before methods are run in most-specific-first order while -;; the :after methods are run in least-specific-first order. -;; The most specific primary method is called after the :before methods -;; and before the :after methods. -;; -;; If only primary methods are used and there is no `call-next-method' -;; calls, only the most specific method is invoked; that is, -;; more specific methods shadow more general ones. -;; http://www.lispworks.com/documentation/HyperSpec/Body/07_ffb.htm - -(defclass person () - ((words :accessor words :initform ()))) - -(defmacro pushback (elt seq) - `(setf ,seq (append ,seq (list ,elt)))) - -(defgeneric talk (obj)) -(defmethod talk ((obj person)) - (print "[person] A person is an individual of the species homo sapiens.") - (pushback 'homo-sapiens (words obj)) nil) - -(defmethod talk :before ((obj person)) - (print "[person :before] A person can talk.") - (pushback 'talk (words obj)) nil) - -(defmethod talk :after ((obj person)) - (print "[person :after] A person can code.") - (pushback 'code (words obj)) nil) - -(define-test test-std-method-combination - (let ((obj (make-instance 'person))) - (talk obj) - (assert-equal '(____ ____ ____) (words obj)))) - -;; The standard method combination follows the order: -;; First the :before methods in most-specific-first order. -;; Then evaluate the most specific primary method. -;; Finally the :after methods in least-specific-first order. -(defclass developer (person) - ((code :accessor code - :initarg :code - :initform "python"))) - -(defmethod talk ((obj developer)) - (print "[dev] A developer is a person who write code for a living.") - (pushback 'living (words obj))) - -(define-test test-std-method-combination-override - (let ((obj (make-instance 'developer))) - (talk obj) - (assert-equal '(____ ____ ____) (words obj)))) - - -;; By default the only primary method run is the most specific. -;; You can force to run the primary method of the super class (a.k.a -;; the parent class) by calling `call-next-method'. -(defclass old-school-developer (developer) ()) -(defmethod talk ((obj old-school-developer)) - (print "[old-school-dev] Old school developers don't use IDE's") - (pushback 'ide (words obj)) - (call-next-method) nil) - -(define-test test-std-method-combination-old-school - (let ((obj (make-instance 'old-school-developer))) - (talk obj) - (assert-equal '(____ ____ ____ ____) (words obj)))) - -;; A subclass with auxiliar methods doesn't override the -;; :before/:after auxiliar methods of the super class; all -;; these methods are evaluated. -(defclass cl-developer (developer) ()) -(defmethod talk :before ((obj cl-developer)) - (print - (format nil "[cl-dev :before] I do write ~a code sometimes..." - (code obj))) - (pushback 'python (words obj))) - -(defmethod talk :after ((obj cl-developer)) - (setf (code obj) "CL") - (print - (format nil "[cl-dev :after] ...and I do write ~a code most of the time :-)" - (code obj))) - (pushback 'CL (words obj))) - -(define-test test-std-method-combination-override-2 - (let ((obj (make-instance 'cl-developer))) - (talk obj) - (assert-equal '(____ ____ ____ ____ ____) (words obj)))) - -;; By default, if an auxiliar method has the keyword :around, then -;; this is the only method executed. -(defclass casual-developer (developer) - ((clothes :reader clothes :initform (list 'trouser 't-shirt)))) - -(defmethod talk :around ((obj casual-developer)) - (print "[casual-dev :around] Usually, developers like to dress casual.") - (pushback 'casual (words obj))) - -(define-test test-std-method-combination-around - (let ((obj (make-instance 'casual-developer))) - (talk obj) - (assert-equal '(____) (words obj)))) - -;; You can use `call-next-method' within an :around -;; method to force the execution of less specific methods. -(defclass good-developer (casual-developer) - ((prop :reader prop :initform 'do-tests))) - -(defmethod talk :around ((obj good-developer)) - (print "[good-dev :around] Good develpers write tests for all their functions.") - (pushback 'tests (words obj)) - (call-next-method)) - -(define-test test-std-method-combination-around-2 - (let ((obj (make-instance 'good-developer))) - (talk obj) - (assert-equal '(____ ____) (words obj)))) - -;; You can use `call-next-method' as many times as you like. -(defclass bad-developer (casual-developer) - ((prop :reader prop :initform 'lazy))) - -(defmethod talk :around ((obj bad-developer)) - (print "[bad-dev :around] Bad developers are lazy.") - (pushback 'lazy (words obj)) - (call-next-method) ; Call :around method from `casual-developer'. - (call-next-method)) ; Again. - -(define-test test-std-method-combination-around-3 - (let ((obj (make-instance 'bad-developer))) - (talk obj) - (assert-equal '(____ ____ ____) (words obj)))) - -;; ---- -(defclass rich-developer (developer) ()) -(defmethod talk :around ((obj rich-developer)) - (print "[rich-dev :around] Rich developers has lot of money." ) - (pushback 'money (words obj)) - ;; Call auxiliar methods from `person' and primary from `developer'. - (call-next-method) - (call-next-method)) ; Again. - -(define-test test-std-method-combination-around-4 - (let ((obj (make-instance 'rich-developer))) - (talk obj) - (assert-equal - '(____ ____ ____ ____ ____ ____ ____) - (words obj)))) - +;;; 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 :reader value :initform :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))) + +(defmethod (setf value) :after ((object access-counter)) + (incf (slot-value object 'access-count))) + +(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)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; In addition to :BEFORE and :AFTER methods is also possible to write :AROUND +;;; methods, whose code executes around the primary method. In such context, it +;;; is possible to call the primary method via CALL-NEXT-METHOD. +;;; In the standard method combination, the :AFTER method, if one exists, is +;;; executed first, and it may choose whether and how to call next methods. + +(defgeneric grab-lollipop () + (:method () :lollipop)) + +(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))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(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 :value))) + +(defmethod remaining-time :around ((object countdown)) + (let ((value (call-next-method))) + (if (<= 0 value) + ;; DECF is similar to INCF. It decreases the value stored in the place + ;; and returns the decreased value. + (decf value) + :bang))) + +(define-test countdown + (let ((countdown (make-instance 'countdown :value 4))) + (assert-equal 3 (remaining-time countdown)) + (assert-equal 2 (remaining-time countdown)) + (assert-equal 1 (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 round-object)) + (incf (counter x) 8) + (call-next-method)) + (:method :around ((x object)) + (incf (counter x) 70) + (call-next-method)) + (:method :before ((x round-object)) + (incf (counter x) 600)) + (:method :before ((x object)) + (incf (counter x) 5000)) + (:method ((x round-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 round-object)) + (incf (counter x) 10000000))) + +(define-test multiple-methods + (let ((object (make-instance 'object))) + (frobnicate object) + (assert-equal ____ (counter object))) + (let ((object (make-instance 'bigger-object))) + (frobnicate object) + (assert-equal ____ (counter object)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; 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 round-object)) + (setf (counter x) 40) + (call-next-method)) + (:method :around ((x object)) + (incf (counter x) 24) + (call-next-method)) + (:method :before ((x round-object)) + (setf (counter x) (mod (counter x) 6))) + (:method :before ((x object)) + (setf (counter x) (/ (counter x) 4))) + (:method ((x round-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 round-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)))) From 08268dc7df7ff67c4981cc07ce125aa092361833 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Fri, 8 May 2020 17:03:52 +0200 Subject: [PATCH 086/133] Add conditions --- koans/condition-handlers.lisp | 364 ++++++++++++++++++++++------------ 1 file changed, 240 insertions(+), 124 deletions(-) diff --git a/koans/condition-handlers.lisp b/koans/condition-handlers.lisp index ddfd5d69..6af91794 100644 --- a/koans/condition-handlers.lisp +++ b/koans/condition-handlers.lisp @@ -1,126 +1,242 @@ -;; 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. - - -"Common lisp conditions are much like CLOS classes. -They are used to handle exceptional situations, and separate -error handling code from normal operational code." - -(define-condition minimal-error-cond (error) ()) -(define-condition minimal-warning-cond (warning) ()) - - -(define-test test-conditions-derive-from-types - "conditions inherit from base types" - (true-or-false? ___ (typep (make-condition 'minimal-error-cond) - 'minimal-error-cond)) - - (true-or-false? ___ (typep (make-condition 'minimal-error-cond) - 'error)) - - (true-or-false? ___ (typep (make-condition 'minimal-error-cond) - 'warning)) - - (true-or-false? ___ (typep (make-condition 'minimal-warning-cond) - 'minimal-warning-cond)) - - (true-or-false? ___ (typep (make-condition 'minimal-warning-cond) - 'error)) - - (true-or-false? ___ (typep (make-condition 'minimal-warning-cond) - 'warning))) - - -;; ---- - - -(define-condition my-div-by-zero-error (error) ()) -(define-condition my-non-number-args-error (error) ()) - -(defun my-divide (num denom) - (if (or (not (numberp num)) - (not (numberp denom))) - (error 'my-non-number-args-error)) - (if (= 0 denom) - (error 'my-div-by-zero-error) - (/ num denom))) - -(define-test assert-error-thrown - "assert-error checks that the right error is thrown" - (assert-equal 3 (my-divide 6 2)) - (assert-error 'my-div-by-zero-error (my-divide 6 0)) - (assert-error ____ (my-divide 6 "zero"))) - - -(define-test test-handle-errors - "the handler case is like a case statement which can capture errors - and warnings, and execute appropriate forms in those conditions." - (assert-equal ___ - (handler-case (my-divide 6 2) - (my-div-by-zero-error (condition) :zero-div-error) - (my-non-number-args-error (condition) :bad-args))) - (assert-equal ___ - (handler-case (my-divide 6 0) - (my-div-by-zero-error (condition) :zero-div-error) - (my-non-number-args-error (condition) :bad-args))) - (assert-equal ___ - (handler-case (my-divide 6 "woops") - (my-div-by-zero-error (condition) :zero-div-error) - (my-non-number-args-error (condition) :bad-args)))) - - -;; ---- - -"conditions, as CLOS objects, can have slots, some of which have special -meanings. Common Lisp the Language Chapter 29 for more details. -http://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node312.html" - -; This error condition is more than a signal. It carries data in two slots. -; the "original-line" slot and the "reason" slot. Both slots have a defined -; :initarg, which they will use to set themselves, if available. If not, -; they have a default form (:initform). They also both provide reader functions - -(define-condition logline-parse-error (error) - ((original-line :initarg :original-line :initform "line not given" :reader original-line) - (reason :initarg :reason :initform "no-reason" :reader reason))) - - -;; This function is designed to take loglines, and report what type they are. -;; It can also throw errors, like div-by-zero above, but the errors now carry some -;; additional information carried within the error itself. - -(defun get-logline-type (in-line) - (if (not (typep in-line 'string)) - ;; if the in-line isn't a string, throw a logline-parse-error, and set the :reason and :original-line - (error 'logline-parse-error :original-line in-line :reason :bad-type-reason)) - (cond - ((equal 0 (search "TIMESTAMP" in-line)) :timestamp-logline-type) - ((if (equal 0 (search "HTTP" in-line)) :http-logline-type)) - ;; if we don't recognize the first token, throw a logline-parse-error, and set the :reason and :original-line - (t (error 'logline-parse-error :original-line in-line :reason :unknown-token-reason)))) - +;;; 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. + +;;; Lisp condition types are very similar to classes. The standard specifies +;;; multiple standard condition types: among them, CONDITION, WARNING, +;;; SERIOUS-CONDITION, and ERROR. + +;;; The type CONDITION is the base type of all condition objects. + +(define-condition my-condition () ()) + +;;; The type WARNING is the base type of all conditions of which the programmer +;;; should be warned, unless the condition is somehow handled by the program. + +(define-condition my-warning (warning) ()) + +;;; The type SERIOUS-CONDITION includes programming errors and other situations +;;; where computation cannot proceed (e.g. due to memory or storage issues). + +(define-condition my-serious-condition (serious-condition) ()) + +;;; The type ERROR is the base type for all error situations in code. + +(define-condition my-error (error) ()) + +(define-test type-hierarchy + ;; Inheritance for condition types works the same way as for classes. + (let ((condition (make-condition 'my-condition))) + (true-or-false? ____ (typep condition 'my-condition)) + (true-or-false? ____ (typep condition 'condition)) + (true-or-false? ____ (typep condition 'warning)) + (true-or-false? ____ (typep condition 'error))) + (let ((condition (make-condition 'my-warning))) + (true-or-false? ____ (typep condition 'my-warning)) + (true-or-false? ____ (typep condition 'warning)) + (true-or-false? ____ (typep condition 'error))) + (let ((condition (make-condition 'my-serious-condition))) + (true-or-false? ____ (typep condition 'my-serious-condition)) + (true-or-false? ____ (typep condition 'serious-condition)) + (true-or-false? ____ (typep condition 'warning)) + (true-or-false? ____ (typep condition 'error))) + (let ((condition (make-condition 'my-error))) + (true-or-false? ____ (typep condition 'my-error)) + (true-or-false? ____ (typep condition 'my-serious-condition)) + (true-or-false? ____ (typep condition 'serious-condition)) + (true-or-false? ____ (typep condition 'warning)) + (true-or-false? ____ (typep condition 'error)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; A condition handler is composed of a handler function that accepts a +;;; condition object and a condition type for which the function will be called. + +(defvar *list*) + +(defun handle-my-error (condition) + (declare (ignore condition)) + (push :my-error *list*)) + +(defun handle-error (condition) + (declare (ignore condition)) + (push :error *list*)) + +(defun handle-my-serious-condition (condition) + (declare (ignore condition)) + (push :my-serious-condition *list*)) + +(define-test handler-bind + ;; When a condition is signaled, all handlers whose type matches the + ;; condition's type are allowed to execute. + (let ((*list* '())) + (handler-bind ((my-error #'handle-my-error) + (error #'handle-error) + (my-serious-condition #'handle-my-serious-condition)) + (signal (make-condition 'my-error))) + (assert-equal ____ *list*))) + +(define-test handler-order + ;; The order of binding handlers matters. + (let ((*list* '())) + (handler-bind ((error #'handle-error) + (my-error #'handle-my-error) + (my-serious-condition #'handle-my-serious-condition)) + (signal (make-condition 'my-error))) + (assert-equal ____ *list*))) + +(define-test multiple-handler-binds + ;; It is possible to bind handlers in steps. + (let ((*list* '())) + (handler-bind ((error #'handle-error) + (my-serious-condition #'handle-my-serious-condition)) + (handler-bind ((my-error #'handle-my-error)) + (signal (make-condition 'my-error)))) + (assert-equal ____ *list*))) + +(define-test same-handler + ;; The same handler may be bound multiple times. + (let ((*list* '())) + (handler-bind ((error #'handle-error) + (error #'handle-error)) + (handler-bind ((my-error #'handle-my-error) + (error #'handle-error) + (my-error #'handle-my-error)) + (signal (make-condition 'my-error)))) + (assert-equal ____ *list*))) + +(define-test handler-types + ;; A handler is not executed if it does not match the condition type. + (let ((*list* '())) + (handler-bind ((error #'handle-error) + (my-error #'handle-my-error) + (my-serious-condition #'handle-my-serious-condition)) + (signal (make-condition 'my-serious-condition))) + (assert-equal ____ *list*))) + +(define-test handler-transfer-of-control + ;; A handler may decline to handle the condition if it returns normally, + ;; or it may handle the condition by transferring control elsewhere. + (let ((*list* '())) + (block my-block + (handler-bind ((error #'handle-error) + (error (lambda (condition) + (declare (ignore condition)) + (return-from my-block))) + (error #'handle-error)) + (signal (make-condition 'my-error)))) + (assert-equal ____ *list*))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-test handler-case + ;; HANDLER-CASE always transfers control before executing the case forms. + (let ((*list* '())) + (handler-case (signal (make-condition 'my-error)) + (error (condition) (handle-error condition)) + (my-error (condition) (handle-my-error condition))) + (assert-equal ____ *list*))) + +(define-test handler-case-order + ;; The order of handler cases matters. + (let ((*list* '())) + (handler-case (signal (make-condition 'my-error)) + (my-error (condition) (handle-my-error condition)) + (error (condition) (handle-error condition))) + (assert-equal ____ *list*))) + +(define-test handler-case-type + ;; A handler cases is not executed if it does not match the condition type. + (let ((*list* '())) + (handler-case (signal (make-condition 'error)) + (my-error (condition) (handle-my-error condition)) + (error (condition) (handle-error condition))) + (assert-equal ____ *list*))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun divide (numerator denominator) + (/ numerator denominator)) + +(define-test error-signaling + ;; ASSERT-ERROR is a Lisp Koans macro which verifies that the correct error + ;; type is signaled. + (assert-equal 3 (divide 6 2)) + (assert-error 'division-by-zero (divide 6 0)) + (assert-error 'type-error (divide 6 :zero))) + +(define-test error-signaling-handler-case + (flet ((try-to-divide (numerator denominator) + ;; In code outside Lisp Koans, HANDLER-CASE should be used. + (handler-case (divide numerator denominator) + (division-by-zero () :division-by-zero) + (type-error () :type-error)))) + (assert-equal ____ (try-to-divide 6 2)) + (assert-equal ____ (try-to-divide 6 0)) + (assert-equal ____ (try-to-divide 6 :zero)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Condition objects can contain metadata about the specific situation that +;;; occurred in the code. + +(define-test accessors-division-by-zero + (let ((condition (handler-case (divide 6 0) (division-by-zero (c) c)))) + (assert-equal ____ (arithmetic-error-operands condition)) + (let ((operation (arithmetic-error-operation condition))) + (assert-equal ____ (funcall operation 12 4))))) + +(define-test accessors-type-error + (let ((condition (handler-case (divide 6 :zero) (type-error (c) c)))) + (assert-equal ____ (type-error-datum condition)) + (let ((expected-type (type-error-expected-type condition))) + (true-or-false? ____ (typep :zero expected-type)) + (true-or-false? ____ (typep 0 expected-type)) + (true-or-false? ____ (typep "zero" expected-type)) + (true-or-false? ____ (typep 0.0 expected-type))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; We can define slots in our own condition types in a way that is similar to +;; DEFCLASS. + +(define-condition parse-log-line-error (parse-error) + ((line :initarg :line :reader line) + (reason :initarg :reason :reader reason))) + +(defun log-line-type (line) + ;; The macro CHECK-TYPE signals a TYPE-ERROR if the object is not of the + ;; specified type. + (check-type line string) + (cond ((= 0 (search "TIMESTAMP" line)) :timestamp) + ((= 0 (search "HTTP" line)) :http) + ((= 0 (search "LOGIN" line)) :login) + ;; The function ERROR should be used for signaling serious conditions + ;; and errors: if the condition is not handled, it halts program + ;; execution and starts the Lisp debugger. + (t (error 'parse-log-line-error :line line + :reason :unknown-log-line-type)))) (define-test test-errors-have-slots - (assert-equal ____ - (handler-case (get-logline-type "TIMESTAMP y13m01d03") - (logline-parse-error (condition) (list (reason condition) (original-line condition))))) - (assert-equal ____ - (handler-case (get-logline-type "HTTP access 128.0.0.100") - (logline-parse-error (condition) (list (reason condition) (original-line condition))))) - (assert-equal ____ - (handler-case (get-logline-type "bogus logline") - (logline-parse-error (condition) (list (reason condition) (original-line condition))))) - (assert-equal ____ - (handler-case (get-logline-type 5555) - (logline-parse-error (condition) (list (reason condition) (original-line condition)))))) + (flet ((try-log-line-type (line) + (handler-case (log-line-type line) + (error (condition) condition)))) + (assert-equal ____ (try-log-line-type "TIMESTAMP 2020-05-08 16:59:39")) + (assert-equal ____ (try-log-line-type "HTTP GET / from 127.0.0.1")) + (assert-equal ____ (try-log-line-type "LOGIN administrator:hunter2")) + (let ((condition (try-log-line-type "WARNING: 95% of disk space used"))) + (assert-equal ____ (line condition)) + (assert-equal ____ (reason condition))) + (let ((condition (try-log-line-type 5555))) + (assert-equal 'string (____ condition)) + (assert-equal 5555 (____ condition))))) From fc77623a2eb927922541ac9feecc6e5d5044f02c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Fri, 8 May 2020 17:18:11 +0200 Subject: [PATCH 087/133] Add conditions and triangle project --- koans/clos.lisp | 4 +- koans/dice-project.lisp | 27 +++++------ koans/std-method-comb.lisp | 16 +++---- koans/triangle-project.lisp | 96 ++++++++++++++++++++++--------------- test-framework.lisp | 6 +-- 5 files changed, 83 insertions(+), 66 deletions(-) diff --git a/koans/clos.lisp b/koans/clos.lisp index 5e106abb..2429352e 100644 --- a/koans/clos.lisp +++ b/koans/clos.lisp @@ -74,8 +74,8 @@ :accessor favorite-lisp-implementation))) (defclass c-programmer (person) - (favorite-c-compiler :initarg :favorite-c-compiler - :accessor favorite-c-compiler)) + ((favorite-c-compiler :initarg :favorite-c-compiler + :accessor favorite-c-compiler))) (define-test inheritance (let ((jack (make-instance 'person :name :jack)) diff --git a/koans/dice-project.lisp b/koans/dice-project.lisp index c5dda8b4..0350e9b6 100644 --- a/koans/dice-project.lisp +++ b/koans/dice-project.lisp @@ -1,17 +1,16 @@ -;; 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. - +;;; 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. ; based on about_dice_project.rb diff --git a/koans/std-method-comb.lisp b/koans/std-method-comb.lisp index f2e7310b..f456d35d 100644 --- a/koans/std-method-comb.lisp +++ b/koans/std-method-comb.lisp @@ -101,24 +101,24 @@ (defclass bigger-object (object) ()) (defgeneric frobnicate (x) - (:method :around ((x round-object)) + (: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 round-object)) + (:method :before ((x bigger-object)) (incf (counter x) 600)) (:method :before ((x object)) (incf (counter x) 5000)) - (:method ((x round-object)) + (: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 round-object)) + (:method :after ((x bigger-object)) (incf (counter x) 10000000))) (define-test multiple-methods @@ -138,24 +138,24 @@ ;;; Fourth, all :AFTER methods are executed, most specific last. (defgeneric calculate (x) - (:method :around ((x round-object)) + (: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 round-object)) + (:method :before ((x bigger-object)) (setf (counter x) (mod (counter x) 6))) (:method :before ((x object)) (setf (counter x) (/ (counter x) 4))) - (:method ((x round-object)) + (: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 round-object)) + (:method :after ((x bigger-object)) (incf (counter x) 2))) (define-test standard-method-combination-order diff --git a/koans/triangle-project.lisp b/koans/triangle-project.lisp index 9809944f..3f4008d3 100644 --- a/koans/triangle-project.lisp +++ b/koans/triangle-project.lisp @@ -1,46 +1,64 @@ -;; 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. +;;; 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. - -"you need to write the triangle method" - -(define-condition triangle-error (error) ()) +(define-condition triangle-error (error) + ;; Fill in the blank with a suitable slot definition. + (____)) (defun triangle (a b c) - :write-me) - - -(define-test test-equilateral-triangles-have-equal-sides - (assert-equal :equilateral (triangle 2 2 2)) - (assert-equal :equilateral (triangle 10 10 10))) - - -(define-test test-isosceles-triangles-have-two-equal-sides - (assert-equal :isosceles (triangle 3 4 4)) - (assert-equal :isosceles (triangle 4 3 4)) - (assert-equal :isosceles (triangle 4 4 3)) - (assert-equal :isosceles (triangle 10 10 2))) + ;;;Fill in the blank with a function that satisfies the below tests. + ____) +(define-test equilateral-triangles + ;; Equilateral triangles have three sides of equal length, + (assert-equal :equilateral (triangle 2 2 2)) + (assert-equal :equilateral (triangle 10 10 10))) -(define-test test-scalene-triangles-have-no-equal-sides - (assert-equal :scalene (triangle 3 4 5)) - (assert-equal :scalene (triangle 10 11 12)) - (assert-equal :scalene (triangle 5 4 2))) +(define-test isosceles-triangles + ;; Isosceles triangles have two sides of equal length, + (assert-equal :isosceles (triangle 3 4 4)) + (assert-equal :isosceles (triangle 4 3 4)) + (assert-equal :isosceles (triangle 4 4 3)) + (assert-equal :isosceles (triangle 10 10 2))) +(define-test scalene-triangles + ;; Scalene triangles have three sides of different lengths. + (assert-equal :scalene (triangle 3 4 5)) + (assert-equal :scalene (triangle 10 11 12)) + (assert-equal :scalene (triangle 5 4 2))) -(define-test test-illegal-triangles-throw-exceptions - (assert-error 'triangle-error (triangle 0 0 0)) - (assert-error 'triangle-error (triangle 3 4 -5)) - (assert-error 'triangle-error (triangle 1 1 3)) - (assert-error 'triangle-error (triangle 2 4 2))) \ No newline at end of file +(define-test illegal-triangles + ;; Not all triplets make valid triangles. + (flet ((triangle-failure (a b c) + (handler-case (progn (triangle a b c) (error "Test failure")) + (error (condition) condition)))) + (let ((condition (triangle-failure 0 0 0))) + (assert-true (typep condition 'type-error)) + (assert-equal 0 (type-error-datum)) + ;; The type (REAL (0)) represents all positive numbers. + (assert-true (subtypep (type-error-expected-type) '(real (0)))) + ;; If two type specifiers are SUBTYPEP of one another, then they represent + ;; the same Lisp type. + (assert-true (subtypep '(real (0)) (type-error-expected-type)))) + (let ((condition (triangle-failure 3 4 -5))) + (assert-true (typep condition 'type-error)) + (assert-equal -5 (type-error-datum)) + (assert-true (subtypep (type-error-expected-type) '(real (0)))) + (assert-true (subtypep '(real (0)) (type-error-expected-type)))) + (let ((condition (triangle-failure 1 1 3))) + (assert-true (typep condition 'triangle-error)) + (assert-equal '(1 1 3) (triangle-error-sides condition))) + (let ((condition (triangle-failure 2 4 2))) + (assert-true (typep condition 'triangle-error)) + (assert-equal '(2 4 2) (triangle-error-sides condition))))) diff --git a/test-framework.lisp b/test-framework.lisp index 20137153..3b46b4c9 100644 --- a/test-framework.lisp +++ b/test-framework.lisp @@ -58,9 +58,9 @@ ;; Blank constants allow the incomplete tests to compile without errors. -(defconstant __ '__) -(defconstant ___ '___) -(defconstant ____ '____) +(defvar __ '__) ;; TODO remove +(defvar ___ '___) ;; TODO remove +(defvar ____ '____) (defvar +blanks+ '(__ ___ ____)) ;;; Global unit test database From 9df2202d977825d325ccf0139ab92852eb465054 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Fri, 8 May 2020 17:36:04 +0200 Subject: [PATCH 088/133] Add dice project, fix some things --- koans/condition-handlers.lisp | 2 +- koans/dice-project.lisp | 118 +++++++++++++++++++--------------- koans/functions.lisp | 2 +- koans/hash-tables.lisp | 2 +- koans/lists.lisp | 4 +- koans/strings.lisp | 6 +- koans/triangle-project.lisp | 8 +-- unused-test-ideas.lisp | 35 ---------- 8 files changed, 77 insertions(+), 100 deletions(-) delete mode 100644 unused-test-ideas.lisp diff --git a/koans/condition-handlers.lisp b/koans/condition-handlers.lisp index 6af91794..24ae56a1 100644 --- a/koans/condition-handlers.lisp +++ b/koans/condition-handlers.lisp @@ -227,7 +227,7 @@ (t (error 'parse-log-line-error :line line :reason :unknown-log-line-type)))) -(define-test test-errors-have-slots +(define-test log-line-type-errors (flet ((try-log-line-type (line) (handler-case (log-line-type line) (error (condition) condition)))) diff --git a/koans/dice-project.lisp b/koans/dice-project.lisp index 0350e9b6..e9a4a3d6 100644 --- a/koans/dice-project.lisp +++ b/koans/dice-project.lisp @@ -12,68 +12,80 @@ ;;; See the License for the specific language governing permissions and ;;; limitations under the License. -; based on about_dice_project.rb +;;; In this project, we are going to define a CLOS class representing a simple +;;; set of dice. There are only two operations on the dice: reading the dice +;;; values and re-rolling their values. -;; In this project we are going to build a CLOS class representing -;; a simple set of dice. There are only two operations on the dice, -;; reading the values, and re-rolling. - - -;; YOU WRITE THIS PART: (defclass dice-set () - () ;; WRITE DICE-SET CLASS BODY HERE -) - -(defmethod get-values ((object dice-set)) - ;; WRITE GET-VALUES METHOD DEFINITION HERE -) + ;; Fill in the blank with a proper slot definition. + (____)) -(defmethod roll (how-many (object dice-set)) - ;; WRITE ROLL METHOD DEFINITION HERE -) +(defmethod dice-values ((object dice-set)) + ____) +(defmethod roll ((count integer) (object dice-set)) + ____) -(define-test test-create-dice-set -;; tests making an instance of the dice-set - (let ((dice (make-instance 'dice-set))) - (assert-true dice))) +(define-test make-dice-set + (let ((dice (make-instance 'dice-set))) + (assert-true (type-of dice 'dice-set)))) +(define-test dice-are-six-sided + (let ((dice (make-instance 'dice-set))) + (roll 5 dice) + (assert-true (typep (dice-values dice) 'list)) + (assert-equal 5 (length (dice-values dice))) + (dolist (die (dice-values dice)) + (assert-true (typep die '(integer 1 6)))))) -(define-test test-rolling-the-dice-returns-a-set-of-integers-between-1-and-6 -;; tests rolling the dice - (let ((dice (make-instance 'dice-set))) - (roll 5 dice) - (assert-true (typep (get-values dice) 'list)) - (assert-equal 5 (length (get-values dice))) - (dolist (x (get-values dice)) - (assert-true (and (>= x 1) - (<= x 6) - (typep x 'integer)))))) +(define-test dice-values-do-not-change-without-rolling + (let ((dice (make-instance 'dice-set))) + (roll 100 dice) + (let ((dice-values-1 (dice-values dice)) + (dice-values-2 (dice-values dice))) + (assert-equal dice-values-1 dice-values-2)))) +(define-test roll-returns-new-dice-values + (let* ((dice (make-instance 'dice-set)) + (dice-values (roll 100 dice))) + (assert-true (equal dice-values (dice-values dice))))) -(define-test test-dice-values-do-not-change-unless-explicitly-rolled -;; tests that dice don't change just by looking at them - (let ((dice (make-instance 'dice-set))) - (roll 100 dice) - (let ((first-time (get-values dice)) - (second-time (get-values dice))) - (assert-equal first-time second-time)))) +(define-test dice-values-should-change-between-rolling + (let* ((dice (make-instance 'dice-set)) + (first-time (roll 100 dice)) + (second-time (roll 100 dice))) + (assert-false (equal first-time second-time)) + (assert-true (equal second-time (dice-values dice))))) +(define-test different-dice-sets-have-different-values + (let* ((dice-1 (make-instance 'dice-set)) + (dice-2 (make-instance 'dice-set))) + (roll 100 dice-1) + (roll 100 dice-2) + (assert-false (equal (dice-values dice-1) (dice-values dice-2))))) -(define-test test-dice-values-should-change-between-rolls -;; tests that rolling the dice DOES change the values. - (let ((dice (make-instance 'dice-set)) - (first-time nil) - (second-time nil)) - (roll 100 dice) - (setf first-time (get-values dice)) - (roll 100 dice) - (setf second-time (get-values dice)) - (assert-false (equal first-time second-time)))) +(define-test different-numbers-of-dice + (let ((dice (make-instance 'dice-set))) + (assert-equal 5 (length (roll 5 dice))) + (assert-equal 100 (length (roll 100 dice))) + (assert-equal 1 (length (roll 1 dice))))) -(define-test test-you-can-roll-different-numbers-of-dice -;; tests count parameter of how many dice to roll - (let ((dice (make-instance 'dice-set))) - (assert-equal 5 (length (roll 5 dice))) - (assert-equal 100 (length (roll 100 dice))) - (assert-equal 1 (length (roll 1 dice))))) +(define-test junk-as-dice-count + (let ((dice (make-instance 'dice-set))) + (labels ((dice-failure (count) + (handler-case (progn (roll-dice count dice) + (error "Test failure")) + (error (condition) condition))) + (test-dice-failure (value) + (let* ((condition (dice-failure value)) + (expected-type (type-error-expected-type condition))) + (assert-true (typep condition 'type-error)) + (assert-equal value (type-error-datum)) + (assert-true (subtypep expected-type '(integer 1 6))) + (assert-true (subtypep '(integer 1 6) expected-type))))) + (test-dice-failure 0) + (test-dice-failure "0") + (test-dice-failure :zero) + (test-dice-failure 18.0) + (test-dice-failure -7) + (test-dice-failure '(6 6 6))))) diff --git a/koans/functions.lisp b/koans/functions.lisp index 2b14d116..c691362d 100644 --- a/koans/functions.lisp +++ b/koans/functions.lisp @@ -143,7 +143,7 @@ (list (function (lambda () x)) (function (lambda (y) (setq x y))))) -(define-test test-lexical-closure-interactions +(define-test lexical-closure-interactions ;; The macro DESTRUCTURING-BIND is like LET, except it binds the variables ;; listed in its first argument to the parts of the list returned by the form ;; that is its second argument. diff --git a/koans/hash-tables.lisp b/koans/hash-tables.lisp index 485d4092..2396f467 100644 --- a/koans/hash-tables.lisp +++ b/koans/hash-tables.lisp @@ -93,7 +93,7 @@ (gethash ____ hash-table-1) ____) (assert-true (equalp hash-table-1 hash-table-2)))) -(define-test test-make-your-own-hash-table +(define-test make-your-own-hash-table ;; Make your own hash table that satisfies the test. (let ((colors ____)) ;; You will need to modify your hash table after you create it. diff --git a/koans/lists.lisp b/koans/lists.lisp index bc1d8d96..ac3d9a52 100644 --- a/koans/lists.lisp +++ b/koans/lists.lisp @@ -100,7 +100,7 @@ (assert-equal ____ list-1) (assert-equal ____ list-2))) -(define-test test-accessing-list-elements +(define-test accessing-list-elements (let ((noms '("peanut" "butter" "and" "jelly"))) ;; Common Lisp defines accessor functions for lists: FIRST, SECOND, ..., ;; up to TENTH. @@ -137,7 +137,7 @@ ;; of cyclic lists. (assert-equal ____ (nth 101 cyclic-list)))) -(define-test test-slicing-lists +(define-test slicing-lists ;; The function SUBSEQ returns a subsequence of a list. (let ((noms (list "peanut" "butter" "and" "jelly"))) (assert-equal ____ (subseq noms 0 1)) diff --git a/koans/strings.lisp b/koans/strings.lisp index 7fca67bf..7b4c71ce 100644 --- a/koans/strings.lisp +++ b/koans/strings.lisp @@ -51,21 +51,21 @@ (assert-equal ____ (char my-string 3)) (assert-equal ____ (aref my-string 7)))) -(define-test test-concatenating-strings +(define-test concatenating-strings ;; Concatenating strings in Common Lisp is possible, if a little cumbersome. (let ((a "Lorem") (b "ipsum") (c "dolor")) (assert-equal ____ (concatenate 'string a " " b " " c)))) -(define-test test-searching-for-characters +(define-test searching-for-characters ;; The function POSITION can be used to find the first position of an element ;; in a sequence. If the element is not found, NIL is returned. (assert-equal ____ (position #\b "abc")) (assert-equal ____ (position #\c "abc")) (assert-equal ____ (position #\d "abc"))) -(define-test test-finding-substrings +(define-test finding-substrings ;; The function SEARCH can be used to search a sequence for subsequences. (let ((title "A supposedly fun thing I'll never do again")) (assert-equal ____ (search "supposedly" title)) diff --git a/koans/triangle-project.lisp b/koans/triangle-project.lisp index 3f4008d3..2eec4805 100644 --- a/koans/triangle-project.lisp +++ b/koans/triangle-project.lisp @@ -47,15 +47,15 @@ (assert-true (typep condition 'type-error)) (assert-equal 0 (type-error-datum)) ;; The type (REAL (0)) represents all positive numbers. - (assert-true (subtypep (type-error-expected-type) '(real (0)))) + (assert-true (subtypep (type-error-expected-type condition) '(real (0)))) ;; If two type specifiers are SUBTYPEP of one another, then they represent ;; the same Lisp type. - (assert-true (subtypep '(real (0)) (type-error-expected-type)))) + (assert-true (subtypep '(real (0)) (type-error-expected-type condition)))) (let ((condition (triangle-failure 3 4 -5))) (assert-true (typep condition 'type-error)) (assert-equal -5 (type-error-datum)) - (assert-true (subtypep (type-error-expected-type) '(real (0)))) - (assert-true (subtypep '(real (0)) (type-error-expected-type)))) + (assert-true (subtypep (type-error-expected-type condition) '(real (0)))) + (assert-true (subtypep '(real (0)) (type-error-expected-type condition)))) (let ((condition (triangle-failure 1 1 3))) (assert-true (typep condition 'triangle-error)) (assert-equal '(1 1 3) (triangle-error-sides condition))) diff --git a/unused-test-ideas.lisp b/unused-test-ideas.lisp deleted file mode 100644 index 48d87cf1..00000000 --- a/unused-test-ideas.lisp +++ /dev/null @@ -1,35 +0,0 @@ -;; 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. - - -; todo: add the nconc example somewhere and take care of the warning. - -'(define-test test-nconc - "nconc like append attaches one list to the end of the other, but - it does so in a more efficient, but potentially destructive way. - Lisp lists are nil terminated. A symbol refers to the beginning of - a list, and then progresses to find the end. 'nconc' simply takes - the nil pointer at the end of the first list, and points it at the - beginning of the next list." - (assert-equal '(:a :b :c) (nconc '(:a :b) '(:c))) ;k - - (let ((abc '(:a :b :c)) - (xyz '(:x :y :z)) - (abcxyz nil)) - (setf abcxyz (nconc abc xyz)) - (assert-equal '(:a :b :c :x :y :z) abcxyz) - (assert-equal '(:a :b :c :x :y :z) abc) - (assert-equal '(:x :y :z) xyz))) - - From b729ac945747f7234658cd8cfc1d40da0f2b1670 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Fri, 8 May 2020 17:48:55 +0200 Subject: [PATCH 089/133] Fix scope and extent --- .koans | 2 +- koans/macros.lisp | 27 +++++------ koans/scope-and-extent.lisp | 97 +++++++++++++++---------------------- 3 files changed, 52 insertions(+), 74 deletions(-) diff --git a/.koans b/.koans index 198230a3..eed46a1f 100644 --- a/.koans +++ b/.koans @@ -4,6 +4,7 @@ #:evaluation #:atoms-vs-lists #:let + #:scope-and-extent #:basic-macros #:lists #:arrays @@ -27,6 +28,5 @@ #:triangle-project #:dice-project #:macros - #:scope-and-extent #+quicklisp #:threads ) diff --git a/koans/macros.lisp b/koans/macros.lisp index 47150a33..c9ebcbe2 100644 --- a/koans/macros.lisp +++ b/koans/macros.lisp @@ -1,17 +1,16 @@ -;; 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. - +;;; 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. ;; A lisp macro is like a function which takes an input lisp form ;; and produces a new output lisp form. Calling the macro diff --git a/koans/scope-and-extent.lisp b/koans/scope-and-extent.lisp index edb2462d..ac55459f 100644 --- a/koans/scope-and-extent.lisp +++ b/koans/scope-and-extent.lisp @@ -1,69 +1,48 @@ -;; 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. - - -(defun shadow-z (z) -;; reuses the symbol name z to build a return value -;; returns a list like (value-of-z, 2) - (cons z - (cons (let ((z 2)) z) - nil))) - -(define-test test-shadowing-a-variable - (assert-equal ___ (shadow-z 1))) - - -(defun code-block-01 () -;; illustrates a basic property of code-blocks +;;; 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. + +(define-test shadowing + (assert-equal ____ (let ((z 4)) (list z (let ((z 2)) z))))) + +(defun block-1 () (block here (return-from here 4) 5)) -(defun code-block-02 () +(defun block-2 () (block outer (block inner (return-from outer 'space) (return-from inner 'tube)) (return-from outer 'valve))) -(define-test test-code-block-01 - (assert-equal ___ (code-block-01))) - -(define-test test-code-block-02 - (assert-equal ___ (code-block-02))) - - -;; About closures and the distinction of lexical and dynamic bindings - -;; this recipe from stackoverflow -;; http://stackoverflow.com/questions/463463/dynamic-and-lexical-variables-in-common-lisp -; (print "no special x: a typical closure.") - -;; bind f to a function which depends on a local variable x -;; then invoke f to see which value of x is returned. - -(define-test test-lexical-bindings-may-be-shadowed - (assert-eq ___ (let ((f (let ((x 10)) - (lambda () x)))) ; <-- x bound lexically - (let ((x 20)) ; form 2 - (funcall f))))) - - -(define-test test-special-bindings-look-back-on-execution-path - (assert-eq ___ (let ((f (let ((x 10)) - (declare (special x)) - (lambda () x)))) ; <-- x bound dynamically - (let ((x 20)) ; form 2 - (declare (special x)) - (funcall f))))) +(define-test block-return-from + (assert-equal ____ (block-01)) + (assert-equal ____ (block-02))) + +;;; See http://www.gigamonkeys.com/book/variables.html + +(define-test lexical-variables-can-be-enclosed + (assert-equal ____ (let ((f (let ((x 10)) + (lambda () x)))) + (let ((x 20)) + (funcall f))))) + +(define-test dynamic-variables-are-affected-by-execution-path + (assert-equal ____ (let ((f (let ((x 10)) + (declare (special x)) + (lambda () x)))) + (let ((x 20)) + (declare (special x)) + (funcall f))))) From 9eeae7d74e67c3c8e9f57aa3b616b56728b15b59 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Fri, 8 May 2020 19:31:04 +0200 Subject: [PATCH 090/133] Fix backquote and macros --- .koans | 1 + koans/backquote.lisp | 65 +++++++++++ koans/iteration.lisp | 17 +++ koans/macros.lisp | 249 ++++++++++++++++++------------------------- koans/threads.lisp | 26 ++--- test-framework.lisp | 4 +- 6 files changed, 200 insertions(+), 162 deletions(-) create mode 100644 koans/backquote.lisp diff --git a/.koans b/.koans index eed46a1f..59234175 100644 --- a/.koans +++ b/.koans @@ -27,6 +27,7 @@ #:condition-handlers #:triangle-project #:dice-project + #:backquote #:macros #+quicklisp #:threads ) diff --git a/koans/backquote.lisp b/koans/backquote.lisp new file mode 100644 index 00000000..d8e15fdb --- /dev/null +++ b/koans/backquote.lisp @@ -0,0 +1,65 @@ +;;; 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. + +;;; Backquote notation is similar to quoting, except it allows for parts of the +;;; resulting expression to be "unquoted". + +(define-test backquote-basics + (let ((x '(123)) + (z '(7 8 9))) + ;; ' quotes an expression normally. + (assert-equal ____ '(x 45 6 z)) + ;; ` backquotes an expression; without any unquotes, it is equivalent to + ;; using the normal quote. + (assert-equal ____ `(x 45 6 z)) + ;; , unquotes a part of the expression. + (assert-equal ____ `(,x 45 6 z)) + (assert-equal ____ `(,x 45 6 ,z)) + ;; ,@ splices an expression into the into the list surrounding it. + (assert-equal ____ `(,x 45 6 ,@z)) + (assert-equal ____ `(,@x 45 6 ,@z)))) + +(define-test backquote-forms + ;; Because of its properties, backquote is useful for constructing Lisp forms + ;; that are macroexpansions or parts of macroexpansions. + (let ((variable 'x)) + ;; Fill in the blank without without using backquote/unquote notation. + (assert-equal ____ + `(if (typep ,variable 'string) + (format nil "The value of ~A is ~A" ',variable ,variable) + (error 'type-error :datum ,variable + :expected-type 'string)))) + (let ((error-type 'type-error) + (error-arguments '(:datum x :expected-type 'string))) + ;; Fill in the blank without without using backquote/unquote notation. + (assert-equal ____ + `(if (typep x 'string) + (format nil "The value of ~A is ~A" 'x x) + (error ',error-type ,@error-arguments))))) + +(define-test numbers-and-words + (let ((number 5) + (word 'dolphin)) + (true-or-false? ____ (equal '(1 3 5) `(1 3 5))) + (true-or-false? ____ (equal '(1 3 5) `(1 3 number))) + (assert-equal _____ `(1 3 ,number)) + (assert-equal _____ `(word ,word ,word word)))) + +(define-test splicing + (let ((axis '(x y z))) + (assert-equal '(the axis are ____) `(the axis are ,axis)) + (assert-equal '(the axis are ____) `(the axis are ,@axis))) + (let ((coordinates '((43.15 77.6) (42.36 71.06)))) + (assert-equal ____ `(the coordinates are ,coordinates)) + (assert-equal ____ `(the coordinates are ,@coordinates)))) diff --git a/koans/iteration.lisp b/koans/iteration.lisp index 20385cbd..e820bc51 100644 --- a/koans/iteration.lisp +++ b/koans/iteration.lisp @@ -40,6 +40,23 @@ (assert-equal ____ (dotimes (i 5 stack) (push i stack))))) +(define-test do + ;; The macro DO accepts a list of variable bindings, a termination test with + ;; epilogue forms, and Lisp code that should be executed on each iteration. + (let ((result '())) + (do ((i 0 (1+ i))) + ((> i 5)) + (push i result)) + (assert-equal ____ result)) + ;; The epilogue of DO can return a value. + (let ((result (do ((i 0 (1+ i)) + ;; A variable bound by DO noes not need to be updated on + ;; each iteration. + (result '())) + ((> i 5) (nreverse result)) + (push i result)))) + (assert-equal ____ result))) + (define-test loop-basic-form ;; The macro LOOP in its simple form loops forever. It is possible to stop the ;; looping by calling the RETURN special form. diff --git a/koans/macros.lisp b/koans/macros.lisp index c9ebcbe2..252c4d0f 100644 --- a/koans/macros.lisp +++ b/koans/macros.lisp @@ -12,150 +12,105 @@ ;;; See the License for the specific language governing permissions and ;;; limitations under the License. -;; A lisp macro is like a function which takes an input lisp form -;; and produces a new output lisp form. Calling the macro -;; first produces new form, and then evaluates it in the context -;; of the macro call. The first phase, the creation of the new -;; macro form, is called 'macro expansion'. - - - -(defmacro repeat-2 (f) (list 'progn f f)) - -(define-test test-macro-expands - "assert-expands checks the expanded macro form against expectation." - (assert-expands - '(progn (do-something arg1 arg2) (do-something arg1 arg2)) - (repeat-2 (do-something arg1 arg2))) - - (assert-expands - ____ - (repeat-2 (setf x (+ 1 x))))) - - -;; ---- - - -(define-test test-backtick-form - "backtick (`) form is much like single-quote (') form, except that subforms - preceded by a comma (,) are evaluated, rather than left as literals" - (let ((num 5) - (word 'dolphin)) - (true-or-false? ___ (equal '(1 3 5) `(1 3 5))) - (true-or-false? ___ (equal '(1 3 5) `(1 3 num))) - (assert-equal ____ `(1 3 ,num)) - (assert-equal ____ `(word ,word ,word word)))) - - -(define-test test-at-form - "The at form, (@) in the backtick context splices a list variables into - the form." - (let ((axis '(x y z))) - (assert-equal '(x y z) axis) - (assert-equal '(the axis are (x y z)) `(the axis are ,axis)) - (assert-equal '(the axis are x y z) `(the axis are ,@axis))) - (let ((coordinates '((43.15 77.6) (42.36 71.06)))) - (assert-equal ____ - `(the coordinates are ,coordinates)) - (assert-equal ____ - `(the coordinates are ,@coordinates)))) - - -;; ---- On Gensym: based on ideas from common lisp cookbook - -;; sets sym1 and sym2 to val -(defmacro double-setf-BAD (sym1 sym2 val) - `(progn (setf ,sym1 ,val) (setf ,sym2 ,val))) - -(define-test test-no-gensym - "macro expansions may introduce difficult to see - interactions" - (let ((x 0) - (y 0)) - (double-setf-BAD x y 10) - (assert-equal x 10) - (assert-equal y 10)) - - (let ((x 0) - (y 0)) - (double-setf-BAD x y (+ x 100)) - (assert-equal x ____) - (assert-equal y ____))) - -;; sets sym1 and sym2 to val -(defmacro double-setf-SAFER (sym1 sym2 val) - (let ((new-fresh-symbol (gensym))) - `(let ((,new-fresh-symbol ,val)) - (progn (setf ,sym1 ,new-fresh-symbol) (setf ,sym2 ,new-fresh-symbol))))) - -(define-test test-with-gensym - "gensym creates a new symbol." - (let ((x 0) - (y 0)) - (double-setf-SAFER x y 10) - (assert-equal x 10) - (assert-equal y 10)) - - (let ((x 0) - (y 0)) - (double-setf-SAFER x y (+ x 100)) - (assert-equal x ____) - (assert-equal y ____))) - - -;; ---- - -(defvar *log* nil) - -(defmacro log-form (form) - "records the body form to the list *log* and then evalues the body normally" - `(let ((retval ,form)) - (push ',form *log*) - retval)) - -(define-test test-basic-log-form - "illustrates how the basic log-form macro above works" - (assert-equal 1978 (* 2 23 43)) - (assert-equal nil *log*) - "log-form does not interfere with the usual return value" - (assert-equal 1978 (log-form (* 2 23 43))) - "log-form records the code which it has been passed" - (assert-equal ___ (length *log*)) - (assert-equal ___ (first *log*)) - "macros evaluating to more macros is ok, if confusing" - (assert-equal 35 (log-form (log-form (- 2013 1978)))) - (assert-equal 3 (length *log*)) - (assert-equal '(log-form (- 2013 1978)) (first *log*)) - (assert-equal '(- 2013 1978) (second *log*))) - -;; Now you must write a more advanced log-form, that also records the value -;; returned by the form - -(defvar *log-with-value* nil) - -;; you must write this macro -(defmacro log-form-with-value (form) - "records the body form, and the form's return value - to the list *log-with-value* and then evalues the body normally" - `(let ((logform nil) - (retval ,form)) - - ;; YOUR MACRO COMPLETION CODE GOES HERE. - - retval)) - - - -(define-test test-log-form-and-value - "log should start out empty" - (assert-equal nil *log-with-value*) - "log-form-with-value does not interfere with the usual return value" - (assert-equal 1978 (log-form-with-value (* 2 23 43))) - "log-form records the code which it has been passed" - (assert-equal 1 (length *log-with-value*)) - (assert-equal '(:form (* 2 23 43) :value 1978) (first *log-with-value*)) - "macros evaluating to more macros is ok, if confusing" - (assert-equal 35 (log-form-with-value (log-form-with-value (- 2013 1978)))) - (assert-equal 3 (length *log-with-value*)) - (assert-equal '(:form (log-form-with-value (- 2013 1978)) :value 35) (first *log-with-value*)) - (assert-equal '(:form (- 2013 1978) :value 35) (second *log-with-value*))) +;;; A Lisp macro is a function that accepts Lisp data and produces a Lisp form. +;;; When the macro is called, its macro function receives unevaluated arguments +;;; and may use them to produce a new Lisp form. This form is then spliced in +;;; place of the original macro call and is then evaluated. + +(defmacro my-and (&rest forms) + ;; We use a LABELS local function to allow for recursive expansion. + (labels ((generate (forms) + (cond ((null forms) 'nil) + ((null (rest forms)) (first forms)) + (t `(when ,(first forms) + ,(generate (rest forms))))))) + (generate forms))) + +(define-test my-and + ;; ASSERT-EXPANDS macroexpands the first form once and checks if it is equal + ;; to the second form. + (assert-expands (my-and (= 0 (random 6)) (error "Bang!")) + (when (= 0 (random 6)) (error "Bang!"))) + (assert-expands (my-and (= 0 (random 6)) + (= 0 (random 6)) + (= 0 (random 6)) + (error "Bang!")) + ____)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; A common macro pitfall is capturing a variable defined by the user. + +(define-test variable-capture + (macrolet ((for ((var start stop) &body body) + `(do ((,var ,start (1+ ,var)) + (limit ,stop)) + ((> ,var limit)) + ,@body))) + (let ((limit 10) + (result '())) + (for (i 0 3) + (push i result) + (assert-equal ____ limit)) + (assert-equal ____ (nreverse result))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Another pitfall is evaluating some forms multiple times where they are only +;;; meant to be evaluated once. + +(define-test multiple-evaluation + ;; We use MACROLET for defining a local macro. + (macrolet ((for ((var start stop) &body body) + `(do ((,var ,start (1+ ,var))) + ((> ,var ,stop)) + ,@body))) + (let ((side-effects '()) + (result '())) + ;; Our functions RETURN-0 and RETURN-3 have side effects. + (flet ((return-0 () (push 0 side-effects) 0) + (return-3 () (push 3 side-effects) 3)) + (for (i (return-0) (return-3)) + (push i result))) + (assert-equal ____ (nreverse result)) + (assert-equal ____ (nreverse side-effects))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Yet another pitfall is not respecting the evaluation order of the macro +;;; subforms. + +(define-test wrong-evaluation-order + (macrolet ((for ((var start stop) &body body) + ;; The function GENSYM creates GENerated SYMbols, guaranteed to + ;; be unique in the whole Lisp system. Because of that, they + ;; cannot capture other symbols, preventing variable capture. + (let ((limit (gensym "LIMIT"))) + `(do ((,limit ,stop) + (,var ,start (1+ ,var))) + ((> ,var ,limit)) + ,@body)))) + (let ((side-effects '()) + (result '())) + (flet ((return-0 () (push 0 side-effects) 0) + (return-3 () (push 3 side-effects) 3)) + (for (i (return-0) (return-3)) + (push i result))) + (assert-equal ____ (nreverse result)) + (assert-equal ____ (nreverse side-effects))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-test for + (macrolet ((for ((var start stop) &body body) + ;; Fill in the blank with a correct FOR macroexpansion that is + ;; not affected by the three macro pitfalls mentioned above. + ____)) + (let ((side-effects '()) + (result '())) + (flet ((return-0 () (push 0 side-effects) 0) + (return-3 () (push 3 side-effects) 3)) + (for (i (return-0) (return-3)) + (push i result))) + (assert-equal '(0 1 2 3) (nreverse result)) + (assert-equal '(0 3) (nreverse side-effects))))) diff --git a/koans/threads.lisp b/koans/threads.lisp index f3efa46f..797efd0a 100644 --- a/koans/threads.lisp +++ b/koans/threads.lisp @@ -1,16 +1,16 @@ -;; 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. +;;; 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. ;; NOTE: This koan group uses quicklisp to load packages that are ;; not part of the Common Lisp specification. diff --git a/test-framework.lisp b/test-framework.lisp index 3b46b4c9..8e51f49f 100644 --- a/test-framework.lisp +++ b/test-framework.lisp @@ -146,9 +146,9 @@ "Assert whether form signals condition." `(expand-assert :error ,form (handler-case ,form (error (e) e)) ,condition)) -(defmacro assert-expands (form expansion) +(defmacro assert-expands (form expected) "Assert whether form expands to expansion." - `(expand-assert :macro ,form (macroexpand-1 ',form) ,expansion)) + `(expand-assert :macro ',form (macroexpand-1 ',form) ',expected)) (defmacro assert-false (form) "Assert whether the form is false." From 1644946f38d108d28ccc20b35797da62aef2763a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Fri, 8 May 2020 21:10:51 +0200 Subject: [PATCH 091/133] Fix threads --- contemplate.lisp | 2 + koans/threads.lisp | 473 ++++++++++++++------------------------------- 2 files changed, 144 insertions(+), 331 deletions(-) diff --git a/contemplate.lisp b/contemplate.lisp index eb892bf5..605675a5 100644 --- a/contemplate.lisp +++ b/contemplate.lisp @@ -24,4 +24,6 @@ (load "test-framework.lisp") (load "lisp-koans.lisp") +#+quicklisp (ql:quickload :bordeaux-threads) + (com.google.lisp-koans:main) diff --git a/koans/threads.lisp b/koans/threads.lisp index 797efd0a..bc1eeebf 100644 --- a/koans/threads.lisp +++ b/koans/threads.lisp @@ -12,336 +12,147 @@ ;;; See the License for the specific language governing permissions and ;;; limitations under the License. -;; NOTE: This koan group uses quicklisp to load packages that are -;; not part of the Common Lisp specification. -;; If you are using quicklisp please feel free to enable this group -;; by following the instructions in the README. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Making threads with bordeaux-threads:make-thread ;; -;; Joining threads with bordeaux-threads:join-thread ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; bordeaux-threads takes a -function- as a parameter. -;; This function will be executed in a separate thread. - -;; Since the execution order of separate threads is not guaranteed, -;; we must -join- the threads in order to make our assertions. - -;; (load "~/.quicklisp/setup.lisp") -(ql:quickload :bordeaux-threads) - -(defvar *greeting* "no greeting") - -(defun sets-socal-greeting () - (setf *greeting* "Sup, dudes")) - -(define-test test-hello-world-thread - "Create a thread which returns 'hello world', then ends. - using a lambda as the supplied function to execute." - (assert-equal *greeting* "no greeting") - (let ((greeting-thread - (bordeaux-threads:make-thread - (lambda () - (setf *greeting* "hello world"))))) - (bordeaux-threads:join-thread greeting-thread) - (assert-equal *greeting* "hello world") - (setf greeting-thread (bordeaux-threads:make-thread #'sets-socal-greeting)) - (bordeaux-threads:join-thread greeting-thread) - (assert-equal *greeting* ____))) - - -(define-test test-join-thread-return-value - "the return value of the thread is passed in bordeaux-threads:join-thread" - (let ((my-thread (bordeaux-threads:make-thread - (lambda () (* 11 99))))) - (assert-equal ____ (bordeaux-threads:join-thread my-thread)))) - - -(define-test test-threads-can-have-names - "Threads can have names. Names can be useful in diagnosing problems - or reporting." - (let ((empty-plus-thread - (bordeaux-threads:make-thread #'+ - :name "what is the sum of no things adding?"))) - (assert-equal (bordeaux-threads:thread-name empty-plus-thread) - ____))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Sending arguments to the thread function: ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun returns-hello-name (name) - (format nil "Hello, ~a" name)) - -(defun double-wrap-list (x y z) - (list (list x y z))) - -;; Create a thread which will print out "Hello -Name-" using -;; the named write-hello-name function. Arguments and functions -;; are handed to threads in a lambda. - -(define-test test-sending-arguments-to-thread - (assert-equal "Hello, Buster" - (bordeaux-threads:join-thread - (bordeaux-threads:make-thread - #'(lambda () - (returns-hello-name "Buster"))))) - (assert-equal ____ - (bordeaux-threads:join-thread - (bordeaux-threads:make-thread - #'(lambda () - (double-wrap-list 3 4 5)))))) - - -;; ---- - -(defvar *accum* 0) - -(defun accum-after-time (time arg1) - "sleeps for time seconds and then adds arg1 to *accum*" - (sleep time) - (incf *accum* arg1)) - -(defvar *before-time-millisec* 0) -(defvar *after-time-millisec* 0) - -;; cheap and dirty time measuring function -(defun duration-ms () - (- *after-time-millisec* *before-time-millisec*)) - -(define-test test-run-in-series - "get internal real time returns a time stamp in milliseconds" - (setf *accum* 0) - (setf *before-time-millisec* (get-internal-real-time)) - (accum-after-time 0.3 1) - (accum-after-time 0.2 2) - (accum-after-time 0.1 4) - (setf *after-time-millisec* (get-internal-real-time)) - (true-or-false? ___ (> (duration-ms) 500)) - (true-or-false? ___ (< (duration-ms) 700)) - (assert-equal *accum* ___)) - -(define-test test-run-in-parallel - "same program as above, executed in threads. Sleeps are simultaneous" - (setf *accum* 0) - (setf *before-time-millisec* (get-internal-real-time)) - (let ((thread-1 (bordeaux-threads:make-thread #'(lambda () (accum-after-time 0.3 1)))) - (thread-2 (bordeaux-threads:make-thread #'(lambda () (accum-after-time 0.2 2)))) - (thread-3 (bordeaux-threads:make-thread #'(lambda () (accum-after-time 0.1 4))))) - (bordeaux-threads:join-thread thread-1) - (bordeaux-threads:join-thread thread-2) - (bordeaux-threads:join-thread thread-3)) - (setf *after-time-millisec* (get-internal-real-time)) - (true-or-false? ___ (> (duration-ms) 200)) - (true-or-false? ___ (< (duration-ms) 400)) - (assert-equal *accum* ___)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; killing renegade threads ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -(defun spawn-looping-thread (name) - "create a never-ending looping thread with a given name" - (bordeaux-threads:make-thread (lambda () (loop)) :name name)) - -(defun main-thread-p (thread) - (string-equal (bordeaux-threads:thread-name thread) - "Main Thread")) - -(defun kill-thread-if-not-main (thread) -" kills a given thread, unless the thread is the main thread. - returns nil if thread is main. - returns a 'terminated~' string otherwise" - (unless (string-equal (bordeaux-threads:thread-name thread) - "Main Thread") - (bordeaux-threads:destroy-thread thread) - (concatenate 'string "terminated " (bordeaux-threads:thread-name thread)))) - -(defun kill-spawned-threads () - "kill all lisp threads except the main thread." - (map 'list 'kill-thread-if-not-main (bordeaux-threads:all-threads))) - -(defun spawn-three-loopers () - "Spawn three run-aways." - (progn - (spawn-looping-thread "looper one") - (spawn-looping-thread "looper two") - (spawn-looping-thread "looper three"))) - -(define-test test-counting-and-killing-threads - "all-threads makes a list of all running threads in this lisp. The sleep - calls are necessary, as killed threads are not instantly removed from the - list of all running threads." - (assert-equal ___ (length (bordeaux-threads:all-threads))) - (kill-thread-if-not-main (spawn-looping-thread "NEVER CATCH ME~! NYA NYA!")) - (sleep 0.01) - (assert-equal ___ (length (bordeaux-threads:all-threads))) - (spawn-three-loopers) - (assert-equal ___ (length (bordeaux-threads:all-threads))) - (kill-spawned-threads) - (sleep 0.01) - (assert-equal ___ (length (bordeaux-threads:all-threads)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; bindings are not inherited across threads ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar *v* 0) - -(defun returns-v () - *v*) - -(define-test test-threads-dont-get-bindings - "bindings are not inherited across threads" - (let ((thread-ret-val (bordeaux-threads:join-thread - (bordeaux-threads:make-thread 'returns-v)))) - (assert-equal thread-ret-val ____)) - (let ((*v* "LEXICAL BOUND VALUE")) - (assert-equal *v* ____) - (let ((thread-ret-val (bordeaux-threads:join-thread - (bordeaux-threads:make-thread 'returns-v)))) - (assert-equal thread-ret-val ____)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; global state (special vars) are ;; -;; shared across threads ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar *g* 0) - -(defun waits-and-increments-g (&optional (n 0.2)) - "sets *g* to 1 + the value of *g* n seconds ago" - (let ((my-remembered-g *g*)) - (sleep n) - (setq *g* (+ 1 my-remembered-g)))) - -(define-test test-serial-wait-and-increment - "incrementing *g* three times and expecting - the final value to be three works." - (setf *g* 0) - (waits-and-increments-g) - (waits-and-increments-g) - (waits-and-increments-g) - (assert-equal *g* ___)) - - -(define-test test-parallel-wait-and-increment - (setf *g* 0) - (let ((thread-1 (bordeaux-threads:make-thread 'waits-and-increments-g)) - (thread-2 (bordeaux-threads:make-thread 'waits-and-increments-g)) - (thread-3 (bordeaux-threads:make-thread 'waits-and-increments-g))) - (bordeaux-threads:join-thread thread-1) - (bordeaux-threads:join-thread thread-2) - (bordeaux-threads:join-thread thread-3) - (assert-equal *g* ___))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Global state can be protected ;; -;; with a mutex. ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(setf *g* 0) -(defvar *gs-mutex* (bordeaux-threads:make-lock "g's lock")) - -(defun protected-increments-g (&optional (n 0.1)) - "Surround all references to *g* within the with-mutex form." - (bordeaux-threads:with-lock-held (*gs-mutex*) - (let ((my-remembered-g *g*)) - (sleep n) - (setq *g* (+ 1 my-remembered-g))))) - -(define-test test-parallel-wait-and-increment-with-mutex - (setf *g* 0) - (let ((thread-1 (bordeaux-threads:make-thread 'protected-increments-g)) - (thread-2 (bordeaux-threads:make-thread 'protected-increments-g)) - (thread-3 (bordeaux-threads:make-thread 'protected-increments-g))) - (bordeaux-threads:join-thread thread-1) - (bordeaux-threads:join-thread thread-2) - (bordeaux-threads:join-thread thread-3) - (assert-equal *g* ___))) - -;;;;;;;;;;;;;;;; -;; Semaphores ;; -;;;;;;;;;;;;;;;; - -;; bordeaux-threads does not allow you to see -;; count on a semaphore, so we make a struct -;; to keep track of both the semaphore and count for us. - -(defstruct semaphore - (semaphore nil :type bordeaux-threads:semaphore) - (count 0 :type integer)) - -(defun make-our-semaphore (&key (count 0) (name "")) - (make-semaphore :semaphore (bordeaux-threads:make-semaphore - :count count - :name name) - :count count)) - -(defun signal-semaphore (semaphore) - (bordeaux-threads:signal-semaphore - (semaphore-semaphore semaphore)) - (incf (semaphore-count semaphore))) - -(defun wait-on-semaphore (semaphore) - (bordeaux-threads:wait-on-semaphore - (semaphore-semaphore semaphore)) - (decf (semaphore-count semaphore))) - -(defun semaphore-name (semaphore) - (semaphore-name (semaphore-semaphore semaphore))) - -;; Incrementing a bordeaux-threads semaphore is an atomic operation -;; but our increment is not. -(defvar *g-semaphore* (make-our-semaphore :name "g" :count 0)) - -(defun semaphore-increments-g () - (signal-semaphore *g-semaphore*)) - -(define-test test-increment-semaphore - (assert-equal ___ (semaphore-count *g-semaphore*)) - (bordeaux-threads:join-thread (bordeaux-threads:make-thread 'semaphore-increments-g :name "S incrementor 1")) - (bordeaux-threads:join-thread (bordeaux-threads:make-thread 'semaphore-increments-g :name "S incrementor 2")) - (bordeaux-threads:join-thread (bordeaux-threads:make-thread 'semaphore-increments-g :name "S incrementor 3")) - (assert-equal ___ (semaphore-count *g-semaphore*))) - - -;; Semaphores can be used to manage resource allocation, and to trigger +;;; This lesson group uses Quicklisp to load Bordeaux Threads, a portability +;;; library for working with threads. This is because threads are not a part of +;;; the Common Lisp standard and implementations do them differently. +;;; If you are using Quicklisp, please feel free to enable this lesson by +;;; following the instructions in the README. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-test thread-return-value + ;; When a thread object is constructed, it accepts a function to execute. + (let* ((thread (bt:make-thread (lambda () (+ 2 2)))) + ;; When the thread's function finishes, its return value becomes the + ;; return value of BT:JOIN-THREAD. + (value (bt:join-thread thread))) + (assert-equal ____ value))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar *variable*) + +(define-test thread-global-bindings + ;; The global value of a variable is shared between all threads. + (setf *variable* 42) + (let ((thread (bt:make-thread (lambda () + (when (= *variable* 42) + (setf *variable* 24) + t))))) + (assert-true (bt:join-thread thread)) + (assert-equal ____ *variable*))) + +(define-test thread-local-bindings + ;; Newly established local bindings of a variable are visible only in the + ;; thread that established these bindings. + (setf *variable* 42) + (let ((thread (bt:make-thread (lambda () + (let ((*variable* 42)) + (setf *variable* 24)))))) + (bt:join-thread thread) + (assert-equal ____ *variable*))) + +(define-test thread-initial-bindings + ;; Initial dynamic bindings may be passed to the new thread. + (setf *variable* 42) + (let ((thread (bt:make-thread (lambda () (setf *variable* 24)) + :initial-bindings '((*variable* . 42))))) + (bt:join-thread thread) + (assert-equal ____ *variable*))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-test thread-name + ;; Threads can have names. + (let ((thread (bt:make-thread #'+ :name "Summing thread"))) + (assert-equal ____ (bt:thread-name thread)) + (assert-equal ____ (bt:join-thread thread)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-test thread-function-arguments + ;; Passing arguments to thread functions requires closing over them. + (let* ((x 240) + (y 18) + (thread (bt:make-thread (lambda () (* x y))))) + (assert-equal ____ (bt:join-thread thread)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-test destroy-thread + ;; Looping and renegade threads can usually be killed via BT:DESTROY-THREAD. + ;; It is the last measure, since doing so might leave the Lisp system in an + ;; unpredictable state if the thread was doing something complex. + (let ((thread (bt:make-thread (lambda () (loop (sleep 1)))))) + (true-or-false? ____ (bt:thread-alive-p thread)) + (bt:destroy-thread thread) + (true-or-false? ____ (bt:thread-alive-p thread)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar *another-variable*) + +;; Preventing concurrent access to some data can be achieved via a lock in +;; order to avoid race conditions. + +(defvar *lock* (bt:make-lock)) + +(define-test lock + (setf *another-variable* 0) + (flet ((increaser () (bt:with-lock-held (*lock*) (incf *another-variable*)))) + (loop repeat 100 + collect (bt:make-thread #'increaser) into threads + finally (loop until (notany #'bt:thread-alive-p threads)) + (assert-equal ____ *another-variable*)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; We can further orchestrate threads by using semaphores. + +(defvar *semaphore* (bt:make-semaphore)) + +(defun signal-our-semaphore () + (bt:signal-semaphore semaphore)) + +(defun wait-on-our-semaphore () + (bt:wait-on-semaphore semaphore :timeout 100)) + +(define-test semaphore + (assert-equal 1 (bt:join-thread (bt:make-thread #'signal-our-semaphore))) + (assert-equal ____ (bt:join-thread (bt:make-thread #'signal-our-semaphore))) + (assert-equal ____ (bt:join-thread (bt:make-thread #'signal-our-semaphore))) + (assert-equal 2 (bt:join-thread (bt:make-thread #'wait-on-our-semaphore))) + (assert-equal ____ (bt:join-thread (bt:make-thread #'wait-on-our-semaphore))) + (assert-equal ____ (bt:join-thread (bt:make-thread #'wait-on-our-semaphore))) + (assert-equal ____ (bt:join-thread (bt:make-thread #'wait-on-our-semaphore)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Semaphores can be used to manage resource allocation and to trigger some ;; threads to run when the semaphore value is above zero. -(defvar *apples* (make-semaphore :name "how many apples" :count 0)) -(defvar *orchard-log* (make-array 10)) -(defvar *next-log-entry* 0) -(defvar *orchard-log-mutex* (bordeaux-threads:make-lock "orchard log mutex")) - -(defun add-to-log (item) - (bordeaux-threads:with-lock-held (*orchard-log-mutex*) - (setf (aref *orchard-log* *next-log-entry*) item) - (incf *next-log-entry*))) - -(defun apple-eater () - (wait-on-semaphore *apples*) - (add-to-log "apple eaten.")) - -(defun apple-grower () - (sleep 0.1) - (add-to-log "apple grown.") - (signal-semaphore *apples*)) - -(defun num-apples () - (semaphore-count *apples*)) - -(define-test test-orchard-simulation - (assert-equal (num-apples) ___) - (let ((eater-thread (bordeaux-threads:make-thread 'apple-eater :name "apple eater thread"))) - (let ((grower-thread (bordeaux-threads:make-thread 'apple-grower :name "apple grower thread"))) - (bordeaux-threads:join-thread eater-thread))) - (assert-equal (aref *orchard-log* 0) ____) - (assert-equal (aref *orchard-log* 1) ____)) +(defvar *foobar-semaphore* (bt:make-semaphore)) + +(defvar *foobar-list*) + +(defun bar-pusher () + (dotimes (i 10) + (sleep 0.01) + (push i (nth i *foobar-list*)) + (push :bar (nth i *foobar-list*)) + ;; We push :BAR before :FOO, so the final list looks like (:FOO :BAR). + (bt:signal-semaphore *foobar-semaphore*))) + +(defun foo-pusher () + (dotimes (i 10) + (bt:wait-on-semaphore *foobar-semaphore*) + (push :foo (nth i *foobar-list*)))) + +(define-test list-of-foobars + (setf *foobar-list* (make-list 10)) + (let ((bar-pusher (bt:make-thread #'bar-pusher)) + (foo-pusher (bt:make-thread #'foo-pusher))) + (bt:join-thread foo-pusher)) + (assert-equal ____ (nth 0 *foobar-list*)) + (assert-equal ____ (nth 1 *foobar-list*)) + (assert-equal ____ (nth 5 *foobar-list*))) From 34454b3fc47155d8a29d1d8495464457a94c0fcd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Fri, 8 May 2020 21:12:55 +0200 Subject: [PATCH 092/133] Remove superfluous blanks --- test-framework.lisp | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/test-framework.lisp b/test-framework.lisp index 8e51f49f..3502f0c6 100644 --- a/test-framework.lisp +++ b/test-framework.lisp @@ -51,17 +51,15 @@ #:assert-expands #:assert-true #:assert-false #:assert-error) ;; Manage tests (:export #:define-test #:test-count #:test-total-count #:run-koans) - ;; Constants for blanks in koans - (:export #:__ #:___ #:____)) + ;; Test blank + (:export #:____)) (in-package #:com.google.lisp-koans.test) -;; Blank constants allow the incomplete tests to compile without errors. +;; The self-evaluating test blank allows many Lisp forms in the koans to compile +;; without errors. -(defvar __ '__) ;; TODO remove -(defvar ___ '___) ;; TODO remove (defvar ____ '____) -(defvar +blanks+ '(__ ___ ____)) ;;; Global unit test database @@ -100,7 +98,7 @@ (defun form-contains-blanks-p (form) (typecase form - (symbol (find form +blanks+)) + (symbol (eq form '____)) (cons (or (form-contains-blanks-p (car form)) (form-contains-blanks-p (cdr form)))))) From 1d6fa2fc32cdc95fd357081ddd3b72e2494471d9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Fri, 8 May 2020 21:19:01 +0200 Subject: [PATCH 093/133] Update extra-credit --- .koans | 1 + koans/extra-credit.lisp | 17 +++++++++-------- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/.koans b/.koans index 59234175..2ff700fa 100644 --- a/.koans +++ b/.koans @@ -30,4 +30,5 @@ #:backquote #:macros #+quicklisp #:threads + #:extra-credit ) diff --git a/koans/extra-credit.lisp b/koans/extra-credit.lisp index 03abe7c7..0e4be3f4 100644 --- a/koans/extra-credit.lisp +++ b/koans/extra-credit.lisp @@ -1,8 +1,9 @@ -;; EXTRA CREDIT: -;; -;; Create a program that will play the Greed Game. -;; Rules for the game are in GREED_RULES.TXT. -;; -;; You already have a DiceSet class and score function you can use. -;; Write a player class and a Game class to complete the project. This -;; is a free form assignment, so approach it however you desire. \ No newline at end of file +;;; EXTRA CREDIT: +;;; +;;; Create a program that will play the Greed game. +;;; The full rules for the game are in the file extra-credit.txt. +;;; +;;; You already have a DICE-SET class and a score function you can use. +;;; Write a PLAYER class and a GAME class to complete the project. +;;; +;;; This is a free form assignment, so approach it however you desire. From 3ce2bbe5d043657ab8b0e4ac150db4db3e9c8333 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Fri, 8 May 2020 21:32:23 +0200 Subject: [PATCH 094/133] Fix FOR indentation --- koans/macros.lisp | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/koans/macros.lisp b/koans/macros.lisp index 252c4d0f..f4f9e607 100644 --- a/koans/macros.lisp +++ b/koans/macros.lisp @@ -50,8 +50,8 @@ (let ((limit 10) (result '())) (for (i 0 3) - (push i result) - (assert-equal ____ limit)) + (push i result) + (assert-equal ____ limit)) (assert-equal ____ (nreverse result))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -71,7 +71,7 @@ (flet ((return-0 () (push 0 side-effects) 0) (return-3 () (push 3 side-effects) 3)) (for (i (return-0) (return-3)) - (push i result))) + (push i result))) (assert-equal ____ (nreverse result)) (assert-equal ____ (nreverse side-effects))))) @@ -95,7 +95,7 @@ (flet ((return-0 () (push 0 side-effects) 0) (return-3 () (push 3 side-effects) 3)) (for (i (return-0) (return-3)) - (push i result))) + (push i result))) (assert-equal ____ (nreverse result)) (assert-equal ____ (nreverse side-effects))))) @@ -111,6 +111,6 @@ (flet ((return-0 () (push 0 side-effects) 0) (return-3 () (push 3 side-effects) 3)) (for (i (return-0) (return-3)) - (push i result))) + (push i result))) (assert-equal '(0 1 2 3) (nreverse result)) (assert-equal '(0 3) (nreverse side-effects))))) From 0df6992f2510866fdfd0da1a1dc79d7014bfbcd3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Fri, 8 May 2020 21:32:37 +0200 Subject: [PATCH 095/133] Add TODO --- koans/threads.lisp | 3 +++ 1 file changed, 3 insertions(+) diff --git a/koans/threads.lisp b/koans/threads.lisp index bc1eeebf..318e39f1 100644 --- a/koans/threads.lisp +++ b/koans/threads.lisp @@ -18,6 +18,9 @@ ;;; If you are using Quicklisp, please feel free to enable this lesson by ;;; following the instructions in the README. +;;; TODO: wait for Bordeaux Threads to implement a portable SEMAPHORE-COUNT +;;; and use it in the semaphore koans. + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-test thread-return-value From 921cc5c320347b07327c69b9a9a3b46cdce7a7a2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Fri, 8 May 2020 21:36:19 +0200 Subject: [PATCH 096/133] Remove Google qualified domain name --- contemplate.lisp | 2 +- lisp-koans.lisp | 10 +++++----- test-framework.lisp | 4 ++-- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/contemplate.lisp b/contemplate.lisp index 605675a5..98e0b973 100644 --- a/contemplate.lisp +++ b/contemplate.lisp @@ -26,4 +26,4 @@ #+quicklisp (ql:quickload :bordeaux-threads) -(com.google.lisp-koans:main) +(net.common-lisp.lisp-koans:main) diff --git a/lisp-koans.lisp b/lisp-koans.lisp index d754cea4..5221bfb6 100644 --- a/lisp-koans.lisp +++ b/lisp-koans.lisp @@ -12,12 +12,12 @@ ;;; See the License for the specific language governing permissions and ;;; limitations under the License. -(defpackage #:com.google.lisp-koans +(defpackage #:net.common-lisp.lisp-koans (:use #:common-lisp - #:com.google.lisp-koans.test) + #:net.common-lisp.lisp-koans.test) (:export #:main)) -(in-package :com.google.lisp-koans) +(in-package #:net.common-lisp.lisp-koans) (defvar *all-koan-groups* (with-open-file (in #p".koans") @@ -28,7 +28,7 @@ ;;; Functions for loading koans (defun package-name-from-group-name (group-name) - (format nil "COM.GOOGLE.LISP-KOANS.KOANS.~A" group-name)) + (format nil "NET.COMMON-LISP.LISP-KOANS.KOANS.~A" group-name)) (defun load-koan-group-named (koan-group-name) (let* ((koan-name (string-downcase (string koan-group-name))) @@ -36,7 +36,7 @@ (koan-package-name (package-name-from-group-name koan-group-name))) (unless (find-package koan-package-name) (make-package koan-package-name - :use '(#:common-lisp #:com.google.lisp-koans.test))) + :use '(#:common-lisp #:net.common-lisp.lisp-koans.test))) (let ((*package* (find-package koan-package-name))) (load (concatenate 'string "koans/" koan-file-name))))) diff --git a/test-framework.lisp b/test-framework.lisp index 3502f0c6..3e43d7fe 100644 --- a/test-framework.lisp +++ b/test-framework.lisp @@ -44,7 +44,7 @@ ;;; 4) Rename the system to not collide with the original LISP-UNIT. ;;; Packages -(defpackage #:com.google.lisp-koans.test +(defpackage #:net.common-lisp.lisp-koans.test (:use #:common-lisp) ;; Assertions (:export #:assert-eq #:assert-eql #:assert-equal #:assert-equalp #:true-or-false? @@ -54,7 +54,7 @@ ;; Test blank (:export #:____)) -(in-package #:com.google.lisp-koans.test) +(in-package #:net.common-lisp.lisp-koans.test) ;; The self-evaluating test blank allows many Lisp forms in the koans to compile ;; without errors. From 698cf95a31a9bfd2e9f1819909e2d3c45ad9c664 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Fri, 8 May 2020 21:39:00 +0200 Subject: [PATCH 097/133] Minor comment edit --- test-framework.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test-framework.lisp b/test-framework.lisp index 3e43d7fe..02557a63 100644 --- a/test-framework.lisp +++ b/test-framework.lisp @@ -38,7 +38,7 @@ ;;; with hash 93d07b2fa6e32364916225f6218e9e7313027c1f ;;; ;;; Modifications were made to: -;;; 1) Support *incomplete* tests in addition to *passing* and *failing* ones +;;; 1) Support incomplete tests in addition to passing and failing ones ;;; 2) End test execution at the first non-passing test ;;; 3) Remove all dead code unrelated to lisp-koans ;;; 4) Rename the system to not collide with the original LISP-UNIT. From 5bd5728c649d647423f8b5d429f1f009b133f071 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Fri, 8 May 2020 21:41:20 +0200 Subject: [PATCH 098/133] Minor textual and README fixes --- README.md | 39 ++++++++++++++++++++++++++------------- lisp-koans.lisp | 6 +++--- 2 files changed, 29 insertions(+), 16 deletions(-) diff --git a/README.md b/README.md index 3d863f39..974e06f3 100644 --- a/README.md +++ b/README.md @@ -30,30 +30,43 @@ Running on a fresh version should output the following: ``` Thinking about ASSERTS - ASSERT-TRUE requires more meditation. - -You have not yet reached enlightenment ... - A koan is incomplete. + FILL-IN-THE-BLANKS requires more meditation. +You have not yet reached enlightenment. + A koan is incomplete. Please meditate on the following code: - File "koans/asserts.lisp" - Koan "ASSERT-TRUE" - Current koan assert status is "(INCOMPLETE)" + File "koans/asserts.lisp" + Koan "FILL-IN-THE-BLANKS" + Current koan assert status is "(INCOMPLETE INCOMPLETE INCOMPLETE)" -You are now 0/169 koans and 0/25 lessons closer to reaching enlightenment +You are now 0/198 koans and 0/31 lessons closer to reaching enlightenment. ``` This indicates that the script has completed, and that the learner should look to asserts.lisp to locate and fix the problem. The problem will be within a define-test expression such as - (define-test assert-true - "t is true. Replace the blank with a t" - (assert-true ___)) +```lisp +;;; In order to progress, fill in the blanks, denoted via ____ in source code. +;;; Sometimes, you will be asked to provide values that are equal to something. -In this case, the test is incomplete, and the student should fill -in the blank (____) with appropriate lisp code to make the assert pass. +(define-test fill-in-the-blanks + (assert-equal ____ 2) + (assert-equal ____ 3.14) + (assert-equal ____ "Hello World")) + +;;; Sometimes, you will be asked to say whether something is true or false, +;;; In Common Lisp, the canonical values for truth and falsehood are T and NIL. + +(define-test assert-true + (assert-true ____)) +(define-test assert-false + (assert-false ____)) +``` + +In this case, the test is incomplete, and the student should fill +in the blank (\_\_\_\_) with appropriate lisp code to make the assert pass. In order to test code, or evaluate tests interactively, students may copy and paste code into the lisp command line REPL. diff --git a/lisp-koans.lisp b/lisp-koans.lisp index 5221bfb6..36a3768f 100644 --- a/lisp-koans.lisp +++ b/lisp-koans.lisp @@ -112,7 +112,7 @@ Write and submit your own improvements to https://github.com/google/lisp-koans! ")) (defun print-progress-message () - (format t "You are now ~A/~A koans and ~A/~A lessons closer to reaching enlightenment~%~%" + (format t "You are now ~A/~A koans and ~A/~A lessons closer to reaching enlightenment.~%~%" (n-passed-koans-overall *collected-results*) (test-total-count) (1- (length *collected-results*)) @@ -120,8 +120,8 @@ Write and submit your own improvements to https://github.com/google/lisp-koans! (defun output-advice () (cond ((any-assert-non-pass-p) - (print-progress-message) - (print-next-suggestion-message)) + (print-next-suggestion-message) + (print-progress-message)) (t (print-completion-message)))) ;;; Main From 413ae21662a727aa8d9f91f20e9638994eba568f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Fri, 8 May 2020 22:04:27 +0200 Subject: [PATCH 099/133] Revert "Remove Google qualified domain name" This reverts commit 921cc5c320347b07327c69b9a9a3b46cdce7a7a2. --- contemplate.lisp | 2 +- lisp-koans.lisp | 10 +++++----- test-framework.lisp | 4 ++-- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/contemplate.lisp b/contemplate.lisp index 98e0b973..605675a5 100644 --- a/contemplate.lisp +++ b/contemplate.lisp @@ -26,4 +26,4 @@ #+quicklisp (ql:quickload :bordeaux-threads) -(net.common-lisp.lisp-koans:main) +(com.google.lisp-koans:main) diff --git a/lisp-koans.lisp b/lisp-koans.lisp index 36a3768f..895113e3 100644 --- a/lisp-koans.lisp +++ b/lisp-koans.lisp @@ -12,12 +12,12 @@ ;;; See the License for the specific language governing permissions and ;;; limitations under the License. -(defpackage #:net.common-lisp.lisp-koans +(defpackage #:com.google.lisp-koans (:use #:common-lisp - #:net.common-lisp.lisp-koans.test) + #:com.google.lisp-koans.test) (:export #:main)) -(in-package #:net.common-lisp.lisp-koans) +(in-package :com.google.lisp-koans) (defvar *all-koan-groups* (with-open-file (in #p".koans") @@ -28,7 +28,7 @@ ;;; Functions for loading koans (defun package-name-from-group-name (group-name) - (format nil "NET.COMMON-LISP.LISP-KOANS.KOANS.~A" group-name)) + (format nil "COM.GOOGLE.LISP-KOANS.KOANS.~A" group-name)) (defun load-koan-group-named (koan-group-name) (let* ((koan-name (string-downcase (string koan-group-name))) @@ -36,7 +36,7 @@ (koan-package-name (package-name-from-group-name koan-group-name))) (unless (find-package koan-package-name) (make-package koan-package-name - :use '(#:common-lisp #:net.common-lisp.lisp-koans.test))) + :use '(#:common-lisp #:com.google.lisp-koans.test))) (let ((*package* (find-package koan-package-name))) (load (concatenate 'string "koans/" koan-file-name))))) diff --git a/test-framework.lisp b/test-framework.lisp index 02557a63..0c1afcf2 100644 --- a/test-framework.lisp +++ b/test-framework.lisp @@ -44,7 +44,7 @@ ;;; 4) Rename the system to not collide with the original LISP-UNIT. ;;; Packages -(defpackage #:net.common-lisp.lisp-koans.test +(defpackage #:com.google.lisp-koans.test (:use #:common-lisp) ;; Assertions (:export #:assert-eq #:assert-eql #:assert-equal #:assert-equalp #:true-or-false? @@ -54,7 +54,7 @@ ;; Test blank (:export #:____)) -(in-package #:net.common-lisp.lisp-koans.test) +(in-package #:com.google.lisp-koans.test) ;; The self-evaluating test blank allows many Lisp forms in the koans to compile ;; without errors. From eab7b896dc29ec9016ae9032e139594cc47d662d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Fri, 8 May 2020 23:29:36 +0200 Subject: [PATCH 100/133] Test stuff, begin working on solved koans --- .koans | 2 +- README.md | 10 + koans-solved/arrays.lisp | 70 +++++ koans-solved/asserts.lisp | 65 +++++ koans-solved/atoms-vs-lists.lisp | 43 ++++ koans-solved/backquote.lisp | 65 +++++ koans-solved/basic-macros.lisp | 112 ++++++++ koans-solved/clos.lisp | 174 +++++++++++++ koans-solved/condition-handlers.lisp | 242 ++++++++++++++++++ koans-solved/control-statements.lisp | 68 +++++ koans-solved/dice-project.lisp | 91 +++++++ koans-solved/equality-distinctions.lisp | 121 +++++++++ koans-solved/evaluation.lisp | 66 +++++ koans-solved/extra-credit.lisp | 9 + koans-solved/extra-credit.txt | 66 +++++ koans-solved/format.lisp | 84 ++++++ koans-solved/functions.lisp | 184 +++++++++++++ koans-solved/hash-tables.lisp | 108 ++++++++ koans-solved/iteration.lisp | 75 ++++++ koans-solved/let.lisp | 62 +++++ koans-solved/lists.lisp | 146 +++++++++++ koans-solved/loops.lisp | 140 ++++++++++ koans-solved/macros.lisp | 116 +++++++++ koans-solved/mapcar-and-reduce.lisp | 97 +++++++ koans-solved/multiple-values.lisp | 41 +++ koans-solved/nil-false-empty.lisp | 52 ++++ koans-solved/scope-and-extent.lisp | 48 ++++ koans-solved/scoring-project.lisp | 82 ++++++ koans-solved/std-method-comb.lisp | 219 ++++++++++++++++ koans-solved/strings.lisp | 73 ++++++ koans-solved/structures.lisp | 111 ++++++++ koans-solved/threads.lisp | 161 ++++++++++++ koans-solved/triangle-project.lisp | 64 +++++ koans-solved/type-checking.lisp | 152 +++++++++++ .../variables-parameters-constants.lisp | 88 +++++++ koans-solved/vectors.lisp | 54 ++++ koans/arrays.lisp | 2 +- koans/basic-macros.lisp | 22 +- koans/evaluation.lisp | 2 +- koans/functions.lisp | 32 +-- koans/hash-tables.lisp | 16 +- koans/lists.lisp | 16 +- koans/scope-and-extent.lisp | 4 +- koans/structures.lisp | 13 +- lisp-koans.lisp | 30 +-- test-framework.lisp | 4 +- test.lisp | 29 +++ 47 files changed, 3461 insertions(+), 70 deletions(-) create mode 100644 koans-solved/arrays.lisp create mode 100644 koans-solved/asserts.lisp create mode 100644 koans-solved/atoms-vs-lists.lisp create mode 100644 koans-solved/backquote.lisp create mode 100644 koans-solved/basic-macros.lisp create mode 100644 koans-solved/clos.lisp create mode 100644 koans-solved/condition-handlers.lisp create mode 100644 koans-solved/control-statements.lisp create mode 100644 koans-solved/dice-project.lisp create mode 100644 koans-solved/equality-distinctions.lisp create mode 100644 koans-solved/evaluation.lisp create mode 100644 koans-solved/extra-credit.lisp create mode 100644 koans-solved/extra-credit.txt create mode 100644 koans-solved/format.lisp create mode 100644 koans-solved/functions.lisp create mode 100644 koans-solved/hash-tables.lisp create mode 100644 koans-solved/iteration.lisp create mode 100644 koans-solved/let.lisp create mode 100644 koans-solved/lists.lisp create mode 100644 koans-solved/loops.lisp create mode 100644 koans-solved/macros.lisp create mode 100644 koans-solved/mapcar-and-reduce.lisp create mode 100644 koans-solved/multiple-values.lisp create mode 100644 koans-solved/nil-false-empty.lisp create mode 100644 koans-solved/scope-and-extent.lisp create mode 100644 koans-solved/scoring-project.lisp create mode 100644 koans-solved/std-method-comb.lisp create mode 100644 koans-solved/strings.lisp create mode 100644 koans-solved/structures.lisp create mode 100644 koans-solved/threads.lisp create mode 100644 koans-solved/triangle-project.lisp create mode 100644 koans-solved/type-checking.lisp create mode 100644 koans-solved/variables-parameters-constants.lisp create mode 100644 koans-solved/vectors.lisp create mode 100644 test.lisp diff --git a/.koans b/.koans index 2ff700fa..89d6da5b 100644 --- a/.koans +++ b/.koans @@ -31,4 +31,4 @@ #:macros #+quicklisp #:threads #:extra-credit -) + ) diff --git a/README.md b/README.md index 974e06f3..14de9912 100644 --- a/README.md +++ b/README.md @@ -71,6 +71,16 @@ in the blank (\_\_\_\_) with appropriate lisp code to make the assert pass. In order to test code, or evaluate tests interactively, students may copy and paste code into the lisp command line REPL. +### Testing + +To test the koans, execute your lisp interpreter on the file 'contemplate.lisp' e.g. + + abcl --noinform --noinit --load test.lisp --eval '(quit)' + ccl -n -l test.lisp -e '(quit)' + clisp -q -norc -ansi test.lisp + ecl -norc -load test.lisp -eval '(quit)' + sbcl --script test.lisp + ## Quoting the Ruby Koans instructions "In test-driven development the mantra has always been, red, green, diff --git a/koans-solved/arrays.lisp b/koans-solved/arrays.lisp new file mode 100644 index 00000000..57d1c256 --- /dev/null +++ b/koans-solved/arrays.lisp @@ -0,0 +1,70 @@ +;;; 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. + +(define-test basic-array-stuff + ;; We make an 8x8 array and then fill it with a checkerboard pattern. + (let ((chess-board (make-array '(8 8)))) + ;; (DOTIMES (X 8) ...) will iterate with X taking values from 0 to 7. + (dotimes (x 8) + (dotimes (y 8) + ;; AREF stands for "array reference". + (setf (aref chess-board x y) (if (evenp (+ x y)) :black :white)))) + (assert-true (typep chess-board 'array)) + (assert-equal :black (aref chess-board 0 0)) + (assert-equal :white (aref chess-board 2 3)) + ;; The function ARRAY-RANK returns the number of dimensions of the array. + (assert-equal 2 (array-rank chess-board)) + ;; The function ARRAY-DIMENSIONS returns a list of the cardinality of the + ;; array dimensions. + (assert-equal '(8 8) (array-dimensions chess-board)) + ;; ARRAY-TOTAL-SIZE returns the total number of elements in the array. + (assert-equal 64 (array-total-size chess-board)))) + +(define-test make-your-own-array + ;; Make your own array that satisfies the test. + (let ((color-cube (make-array '(3 3 3)))) + ;; You may need to modify your array after you create it. + (setf (aref color-cube 0 1 2) :red + (aref color-cube 2 1 0) :white) + (if (typep color-cube '(simple-array T (3 3 3))) + (progn + (assert-equal 3 (array-rank color-cube)) + (assert-equal '(3 3 3) (array-dimensions color-cube)) + (assert-equal 27 (array-total-size color-cube)) + (assert-equal (aref color-cube 0 1 2) :red) + (assert-equal (aref color-cube 2 1 0) :white)) + (assert-true nil)))) + +(define-test adjustable-array + ;; The size of an array does not need to be constant. + (let ((x (make-array '(2 2) :initial-element 5 :adjustable t))) + (assert-equal 5 (aref x 1 0)) + (assert-equal '(2 2) (array-dimensions x)) + (adjust-array x '(3 4)) + (assert-equal '(3 4) (array-dimensions x)))) + +(define-test make-array-from-list + ;; One can create arrays with initial contents. + (let ((x (make-array '(4) :initial-contents '(:one :two :three :four)))) + (assert-equal '(4) (array-dimensions x)) + (assert-equal :one (aref x 0)))) + +(define-test row-major-index + ;; Row major indexing is a way to access elements with a single integer, + ;; rather than a list of integers. + (let ((my-array (make-array '(2 2 2 2)))) + (dotimes (i (* 2 2 2 2)) + (setf (row-major-aref my-array i) i)) + (assert-equal 0 (aref my-array 0 0 0 0)) + (assert-equal 15 (aref my-array 1 1 1 1)))) diff --git a/koans-solved/asserts.lisp b/koans-solved/asserts.lisp new file mode 100644 index 00000000..d3a7f292 --- /dev/null +++ b/koans-solved/asserts.lisp @@ -0,0 +1,65 @@ +;;; 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. + +;;; ╭╮ ╭╮ /////// +;;; ┃┃ ┃┃/////// +;;; ┃┃╭┳━━┳━━╮ ┃┃╭┳━━┳━━┳━╮╭━━╮ +;;; ┃┃┣┫━━┫╭╮┃ ┃╰╯┫╭╮┃╭╮┃╭╮┫━━┫ +;;; ┃╰┫┣━━┃╰╯┃ ┃╭╮┫╰╯┃╭╮┃┃┃┣━━┃ +;;; ╰━┻┻━━┫╭━╯/╰╯╰┻━━┻╯╰┻╯╰┻━━╯ +;;; ┃┃ ////// +;;; ╰╯////// + +;;; Welcome to the Lisp Koans. +;;; May the code stored here influence your enlightenment as a programmer. + +;;; In order to progress, fill in the blanks, denoted via ____ in source code. +;;; Sometimes, you will be asked to provide values that are equal to something. + +(define-test fill-in-the-blanks + (assert-equal 2 2) + (assert-equal 3.14 3.14) + (assert-equal "Hello World" "Hello World")) + +;;; Sometimes, you will be asked to say whether something is true or false, +;;; In Common Lisp, the canonical values for truth and falsehood are T and NIL. + +(define-test assert-true + (assert-true t)) + +(define-test assert-false + (assert-false nil)) + +(define-test true-or-false + (true-or-false? t (= 34 34)) + (true-or-false? nil (= 19 78))) + +;;; Since T and NIL are symbols, you can type them in lowercase or uppercase; +;;; by default, Common Lisp will automatically upcase them upon reading. + +(define-test upcase-downcase + ;; Try inserting a lowercase t here. + (assert-equal t T) + ;; Try inserting an uppercase NIL here. + (assert-equal NIL nil)) + +;;; Sometimes, you will be asked to provide a part of an expression that must be +;;; either true or false. + +(define-test a-true-assertion + (assert-true (= 4 (+ 2 2)))) + +(define-test a-false-assertion + (assert-false (= 5 (+ 2 2)))) + diff --git a/koans-solved/atoms-vs-lists.lisp b/koans-solved/atoms-vs-lists.lisp new file mode 100644 index 00000000..ef1c2fe3 --- /dev/null +++ b/koans-solved/atoms-vs-lists.lisp @@ -0,0 +1,43 @@ +;;; 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. + +;;; Lists in lisp are forms beginning and ending with rounded parentheses. +;;; Atoms are symbols, numbers, or other forms usually separated by whitespace +;;; or parentheses. + +(define-test list-or-atom + ;; The function LISTP will return true if the input is a list. + ;; The function ATOM will return true if the input is an atom. + (true-or-false? t (listp '(1 2 3))) + (true-or-false? nil (atom '(1 2 3))) + (true-or-false? t (listp '("heres" "some" "strings"))) + (true-or-false? nil (atom '("heres" "some" "strings"))) + (true-or-false? nil (listp "a string")) + (true-or-false? t (atom "a string")) + (true-or-false? nil (listp 2)) + (true-or-false? t (atom 2)) + (true-or-false? t (listp '(("first" "list") ("second" "list")))) + (true-or-false? nil (atom '(("first" "list") ("second" "list"))))) + +(define-test the-duality-of-nil + ;; The empty list, NIL, is unique in that it is both a list and an atom. + (true-or-false? t (listp nil)) + (true-or-false? t (atom nil))) + +(define-test keywords + ;; Symbols like :HELLO or :LIKE-THIS are keywords. They are treated + ;; differently in Lisp: they are constants that always evaluate to themselves. + (true-or-false? t (equal :this-is-a-keyword :this-is-a-keyword)) + (true-or-false? t (equal :this-is-a-keyword ':this-is-a-keyword)) + (true-or-false? nil (equal :this-is-a-keyword :this-is-also-a-keyword))) diff --git a/koans-solved/backquote.lisp b/koans-solved/backquote.lisp new file mode 100644 index 00000000..d8e15fdb --- /dev/null +++ b/koans-solved/backquote.lisp @@ -0,0 +1,65 @@ +;;; 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. + +;;; Backquote notation is similar to quoting, except it allows for parts of the +;;; resulting expression to be "unquoted". + +(define-test backquote-basics + (let ((x '(123)) + (z '(7 8 9))) + ;; ' quotes an expression normally. + (assert-equal ____ '(x 45 6 z)) + ;; ` backquotes an expression; without any unquotes, it is equivalent to + ;; using the normal quote. + (assert-equal ____ `(x 45 6 z)) + ;; , unquotes a part of the expression. + (assert-equal ____ `(,x 45 6 z)) + (assert-equal ____ `(,x 45 6 ,z)) + ;; ,@ splices an expression into the into the list surrounding it. + (assert-equal ____ `(,x 45 6 ,@z)) + (assert-equal ____ `(,@x 45 6 ,@z)))) + +(define-test backquote-forms + ;; Because of its properties, backquote is useful for constructing Lisp forms + ;; that are macroexpansions or parts of macroexpansions. + (let ((variable 'x)) + ;; Fill in the blank without without using backquote/unquote notation. + (assert-equal ____ + `(if (typep ,variable 'string) + (format nil "The value of ~A is ~A" ',variable ,variable) + (error 'type-error :datum ,variable + :expected-type 'string)))) + (let ((error-type 'type-error) + (error-arguments '(:datum x :expected-type 'string))) + ;; Fill in the blank without without using backquote/unquote notation. + (assert-equal ____ + `(if (typep x 'string) + (format nil "The value of ~A is ~A" 'x x) + (error ',error-type ,@error-arguments))))) + +(define-test numbers-and-words + (let ((number 5) + (word 'dolphin)) + (true-or-false? ____ (equal '(1 3 5) `(1 3 5))) + (true-or-false? ____ (equal '(1 3 5) `(1 3 number))) + (assert-equal _____ `(1 3 ,number)) + (assert-equal _____ `(word ,word ,word word)))) + +(define-test splicing + (let ((axis '(x y z))) + (assert-equal '(the axis are ____) `(the axis are ,axis)) + (assert-equal '(the axis are ____) `(the axis are ,@axis))) + (let ((coordinates '((43.15 77.6) (42.36 71.06)))) + (assert-equal ____ `(the coordinates are ,coordinates)) + (assert-equal ____ `(the coordinates are ,@coordinates)))) diff --git a/koans-solved/basic-macros.lisp b/koans-solved/basic-macros.lisp new file mode 100644 index 00000000..dc6caba7 --- /dev/null +++ b/koans-solved/basic-macros.lisp @@ -0,0 +1,112 @@ +;;; 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. + +(define-test setf + ;; SETF is a macro used to assign values to places. A place is a concept; + ;; it is an abstract "somewhere" where a value is stored. + (let ((a 10) + (b (list 1 20 30 40 50)) + ;; We use COPY-SEQ to create a copy of a string, because using SETF to + ;; modify literal data (strings, lists, etc.) is undefined behaviour. + (c (copy-seq "I am Tom."))) + ;; A place may be a variable. + (setf a 1000) + (assert-equal 1000 a) + ;; A place may be a part of some list. + (setf (first b) 10) + (assert-equal '(10 20 30 40 50) b) + ;; A place may be a character in a string. + ;; The #\x syntax denotes a single character, 'x'. + (setf (char c 5) #\B + (char c 7) #\b) + (assert-equal "I am Bob." c) + ;; There are other kinds of places that we will explore in the future. + )) + +(define-test case + ;; CASE is a simple pattern-matching macro, not unlike C's "switch". + ;; It compares an input against a set of values and evaluates the code for + ;; the branch where a match is found. + (let* ((a 4) + (b (case a + (3 :three) + (4 :four) + (5 :five)))) + (assert-equal :four b)) + ;; CASE can accept a group of keys. + (let* ((c 4) + (d (case c + ((0 2 4 6 8) :even-digit) + ((1 3 5 7 9) :odd-digit)))) + (assert-equal :even-digit d))) + +(defun match-special-cases (thing) + ;; T or OTHERWISE passed as the key matches any value. + ;; NIL passed as the key matches no values. + ;; These symbols need to passed in parentheses. + (case thing + ((t) :found-a-t) + ((nil) :found-a-nil) + (t :something-else))) + +(define-test special-cases-of-case + ;; You need to fill in the blanks in MATCH-SPECIAL-CASES. + (assert-equal :found-a-t (match-special-cases t)) + (assert-equal :found-a-nil (match-special-cases nil)) + (assert-equal :something-else (match-special-cases 42))) + +(define-test your-own-case-statement + ;; We use FLET to define a local function. + (flet ((cartoon-dads (input) + (case input + ;; Fill in the blanks with proper cases. + (:bart :homer) + (:stewie :peter) + (:stan :randy) + (:this-one-doesnt-happen :fancy-cat) + (t :unknown)))) + (assert-equal (cartoon-dads :bart) :homer) + (assert-equal (cartoon-dads :stewie) :peter) + (assert-equal (cartoon-dads :stan) :randy) + (assert-equal (cartoon-dads :space-ghost) :unknown))) + +(define-test limits-of-case + ;; So far, we have been comparing objects using EQUAL, one of the Lisp + ;; comparison functions. CASE compares the keys using EQL, which is distinct + ;; from EQUAL. + ;; EQL is suitable for comparing numbers, characters, and objects for whom we + ;; want to check verify they are the same object. + (let* ((string "A string") + (string-copy (copy-seq string))) + ;; The above means that two distinct strings will not be the same under EQL, + ;; even if they have the same contents. + (true-or-false? nil (eql string string-copy)) + (true-or-false? t (equal string string-copy)) + ;; The above also means that CASE might give surprising results when used on + ;; strings. + (let ((match (case string + ("A string" :matched) + (t :not-matched)))) + (assert-equal :not-matched match)) + ;; We will explore this topic further in the EQUALITY-DISTINCTIONS lesson. + )) + +(define-test cond + ;; COND is similar to CASE, except it is more general. It accepts arbitrary + ;; conditions and checks them in order until one of them is met. + (let* ((number 4) + (result (cond ((> number 0) :positive) + ((< number 0) :negative) + (t :zero)))) + (assert-equal :positive result))) diff --git a/koans-solved/clos.lisp b/koans-solved/clos.lisp new file mode 100644 index 00000000..2429352e --- /dev/null +++ b/koans-solved/clos.lisp @@ -0,0 +1,174 @@ +;;; 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. + +;;; CLOS is a shorthand for Common Lisp Object System. + +(defclass racecar () + ;; A class definition lists all the slots of every instance. + (color speed)) + +(define-test defclass + ;; Class instances are constructed via MAKE-INSTANCE. + (let ((car-1 (make-instance 'racecar)) + (car-2 (make-instance 'racecar))) + ;; Slot values can be set via SLOT-VALUE. + (setf (slot-value car-1 'color) :red) + (setf (slot-value car-1 'speed) 220) + (setf (slot-value car-2 'color) :blue) + (setf (slot-value car-2 'speed) 240) + (assert-equal ____ (slot-value car-1 'color)) + (assert-equal ____ (slot-value car-2 'speed)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass spaceship () + ;; It is possible to define reader, writer, and accessor functions for slots. + ((color :reader color :writer (setf color)) + (speed :accessor color))) + +;;; Specifying a reader function named COLOR is equivalent to +;;; (DEFMETHOD COLOR ((OBJECT SPACECSHIP)) ...) +;;; Specifying a writer function named (SETF COLOR) is equivalent to +;;; (DEFMETHOD (SETF COLOR) (NEW-VALUE (OBJECT SPACECSHIP)) ...) +;;; Specifying an accessor function performs both of the above. + +(define-test accessors + (let ((ship (make-instance 'spaceship))) + (setf (color ship) :orange + (speed ship) 1000) + (assert-equal ____ (color ship)) + (assert-equal ____ (speed ship)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass bike () + ;; It is also possible to define initial arguments for slots. + ((color :reader color :initarg :color) + (speed :reader color :initarg :color))) + +(define-test initargs + (let ((bike (make-instance 'bike :color :blue :speed 30))) + (assert-equal ____ (color bike)) + (assert-equal ____ (speed bike)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Lisp classes can inherit from one another. + +(defclass person () + ((name :initarg :name :accessor person-name))) + +(defclass lisp-programmer (person) + ((favorite-lisp-implementation :initarg :favorite-lisp-implementation + :accessor favorite-lisp-implementation))) + +(defclass c-programmer (person) + ((favorite-c-compiler :initarg :favorite-c-compiler + :accessor favorite-c-compiler))) + +(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 :llvm))) + (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)))) + +;;; This includes multiple inheritance. + +(defclass clisp-programmer (lisp-programmer c-programmer) ()) + +(define-test multiple-inheritance + (let ((zenon (make-instance 'clisp-programmer + :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 'embeddable-common-lisp-programmer)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Multiple inheritance makes it possible to work with mixin classes. + +(defclass greeting-mixin () + ((greeted-people :accessor greeted-people :initform '()))) + +(defgeneric greet (greeter greetee)) + +(defmethod greet ((object greeting-mixin) name) + ;; PUSHNEW is similar to PUSH, but it does not modify the place if the object + ;; we want to push is already found on the list in the place. + (pushnew name (greeted-people object) :test #'equal) + (format nil "Hello, ~A." name)) + +(defclass chatbot () + ((version :reader version :initarg :version))) + +(defclass greeting-chatbot (greeting-mixin chatbot) ()) + +(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)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass american (person) ()) + +(defclass italian (person) ()) + +(defgeneric stereotypical-food (person) + ;; The :METHOD option in DEFGENERIC is an alternative to DEFMETHOD. + (:method ((person italian)) :pasta) + (:method ((person american)) :burger)) + +;;; When methods or slot definitions of superclasses overlap with each other, +;;; the order of superclasses is used to resolve the conflict. + +(defclass stereotypical-person (american italian) ()) + +(defclass another-stereotypical-person (italian american) ()) + +(define-test stereotypes + (let ((james (make-instance 'american)) + (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)))) diff --git a/koans-solved/condition-handlers.lisp b/koans-solved/condition-handlers.lisp new file mode 100644 index 00000000..24ae56a1 --- /dev/null +++ b/koans-solved/condition-handlers.lisp @@ -0,0 +1,242 @@ +;;; 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. + +;;; Lisp condition types are very similar to classes. The standard specifies +;;; multiple standard condition types: among them, CONDITION, WARNING, +;;; SERIOUS-CONDITION, and ERROR. + +;;; The type CONDITION is the base type of all condition objects. + +(define-condition my-condition () ()) + +;;; The type WARNING is the base type of all conditions of which the programmer +;;; should be warned, unless the condition is somehow handled by the program. + +(define-condition my-warning (warning) ()) + +;;; The type SERIOUS-CONDITION includes programming errors and other situations +;;; where computation cannot proceed (e.g. due to memory or storage issues). + +(define-condition my-serious-condition (serious-condition) ()) + +;;; The type ERROR is the base type for all error situations in code. + +(define-condition my-error (error) ()) + +(define-test type-hierarchy + ;; Inheritance for condition types works the same way as for classes. + (let ((condition (make-condition 'my-condition))) + (true-or-false? ____ (typep condition 'my-condition)) + (true-or-false? ____ (typep condition 'condition)) + (true-or-false? ____ (typep condition 'warning)) + (true-or-false? ____ (typep condition 'error))) + (let ((condition (make-condition 'my-warning))) + (true-or-false? ____ (typep condition 'my-warning)) + (true-or-false? ____ (typep condition 'warning)) + (true-or-false? ____ (typep condition 'error))) + (let ((condition (make-condition 'my-serious-condition))) + (true-or-false? ____ (typep condition 'my-serious-condition)) + (true-or-false? ____ (typep condition 'serious-condition)) + (true-or-false? ____ (typep condition 'warning)) + (true-or-false? ____ (typep condition 'error))) + (let ((condition (make-condition 'my-error))) + (true-or-false? ____ (typep condition 'my-error)) + (true-or-false? ____ (typep condition 'my-serious-condition)) + (true-or-false? ____ (typep condition 'serious-condition)) + (true-or-false? ____ (typep condition 'warning)) + (true-or-false? ____ (typep condition 'error)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; A condition handler is composed of a handler function that accepts a +;;; condition object and a condition type for which the function will be called. + +(defvar *list*) + +(defun handle-my-error (condition) + (declare (ignore condition)) + (push :my-error *list*)) + +(defun handle-error (condition) + (declare (ignore condition)) + (push :error *list*)) + +(defun handle-my-serious-condition (condition) + (declare (ignore condition)) + (push :my-serious-condition *list*)) + +(define-test handler-bind + ;; When a condition is signaled, all handlers whose type matches the + ;; condition's type are allowed to execute. + (let ((*list* '())) + (handler-bind ((my-error #'handle-my-error) + (error #'handle-error) + (my-serious-condition #'handle-my-serious-condition)) + (signal (make-condition 'my-error))) + (assert-equal ____ *list*))) + +(define-test handler-order + ;; The order of binding handlers matters. + (let ((*list* '())) + (handler-bind ((error #'handle-error) + (my-error #'handle-my-error) + (my-serious-condition #'handle-my-serious-condition)) + (signal (make-condition 'my-error))) + (assert-equal ____ *list*))) + +(define-test multiple-handler-binds + ;; It is possible to bind handlers in steps. + (let ((*list* '())) + (handler-bind ((error #'handle-error) + (my-serious-condition #'handle-my-serious-condition)) + (handler-bind ((my-error #'handle-my-error)) + (signal (make-condition 'my-error)))) + (assert-equal ____ *list*))) + +(define-test same-handler + ;; The same handler may be bound multiple times. + (let ((*list* '())) + (handler-bind ((error #'handle-error) + (error #'handle-error)) + (handler-bind ((my-error #'handle-my-error) + (error #'handle-error) + (my-error #'handle-my-error)) + (signal (make-condition 'my-error)))) + (assert-equal ____ *list*))) + +(define-test handler-types + ;; A handler is not executed if it does not match the condition type. + (let ((*list* '())) + (handler-bind ((error #'handle-error) + (my-error #'handle-my-error) + (my-serious-condition #'handle-my-serious-condition)) + (signal (make-condition 'my-serious-condition))) + (assert-equal ____ *list*))) + +(define-test handler-transfer-of-control + ;; A handler may decline to handle the condition if it returns normally, + ;; or it may handle the condition by transferring control elsewhere. + (let ((*list* '())) + (block my-block + (handler-bind ((error #'handle-error) + (error (lambda (condition) + (declare (ignore condition)) + (return-from my-block))) + (error #'handle-error)) + (signal (make-condition 'my-error)))) + (assert-equal ____ *list*))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-test handler-case + ;; HANDLER-CASE always transfers control before executing the case forms. + (let ((*list* '())) + (handler-case (signal (make-condition 'my-error)) + (error (condition) (handle-error condition)) + (my-error (condition) (handle-my-error condition))) + (assert-equal ____ *list*))) + +(define-test handler-case-order + ;; The order of handler cases matters. + (let ((*list* '())) + (handler-case (signal (make-condition 'my-error)) + (my-error (condition) (handle-my-error condition)) + (error (condition) (handle-error condition))) + (assert-equal ____ *list*))) + +(define-test handler-case-type + ;; A handler cases is not executed if it does not match the condition type. + (let ((*list* '())) + (handler-case (signal (make-condition 'error)) + (my-error (condition) (handle-my-error condition)) + (error (condition) (handle-error condition))) + (assert-equal ____ *list*))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun divide (numerator denominator) + (/ numerator denominator)) + +(define-test error-signaling + ;; ASSERT-ERROR is a Lisp Koans macro which verifies that the correct error + ;; type is signaled. + (assert-equal 3 (divide 6 2)) + (assert-error 'division-by-zero (divide 6 0)) + (assert-error 'type-error (divide 6 :zero))) + +(define-test error-signaling-handler-case + (flet ((try-to-divide (numerator denominator) + ;; In code outside Lisp Koans, HANDLER-CASE should be used. + (handler-case (divide numerator denominator) + (division-by-zero () :division-by-zero) + (type-error () :type-error)))) + (assert-equal ____ (try-to-divide 6 2)) + (assert-equal ____ (try-to-divide 6 0)) + (assert-equal ____ (try-to-divide 6 :zero)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Condition objects can contain metadata about the specific situation that +;;; occurred in the code. + +(define-test accessors-division-by-zero + (let ((condition (handler-case (divide 6 0) (division-by-zero (c) c)))) + (assert-equal ____ (arithmetic-error-operands condition)) + (let ((operation (arithmetic-error-operation condition))) + (assert-equal ____ (funcall operation 12 4))))) + +(define-test accessors-type-error + (let ((condition (handler-case (divide 6 :zero) (type-error (c) c)))) + (assert-equal ____ (type-error-datum condition)) + (let ((expected-type (type-error-expected-type condition))) + (true-or-false? ____ (typep :zero expected-type)) + (true-or-false? ____ (typep 0 expected-type)) + (true-or-false? ____ (typep "zero" expected-type)) + (true-or-false? ____ (typep 0.0 expected-type))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; We can define slots in our own condition types in a way that is similar to +;; DEFCLASS. + +(define-condition parse-log-line-error (parse-error) + ((line :initarg :line :reader line) + (reason :initarg :reason :reader reason))) + +(defun log-line-type (line) + ;; The macro CHECK-TYPE signals a TYPE-ERROR if the object is not of the + ;; specified type. + (check-type line string) + (cond ((= 0 (search "TIMESTAMP" line)) :timestamp) + ((= 0 (search "HTTP" line)) :http) + ((= 0 (search "LOGIN" line)) :login) + ;; The function ERROR should be used for signaling serious conditions + ;; and errors: if the condition is not handled, it halts program + ;; execution and starts the Lisp debugger. + (t (error 'parse-log-line-error :line line + :reason :unknown-log-line-type)))) + +(define-test log-line-type-errors + (flet ((try-log-line-type (line) + (handler-case (log-line-type line) + (error (condition) condition)))) + (assert-equal ____ (try-log-line-type "TIMESTAMP 2020-05-08 16:59:39")) + (assert-equal ____ (try-log-line-type "HTTP GET / from 127.0.0.1")) + (assert-equal ____ (try-log-line-type "LOGIN administrator:hunter2")) + (let ((condition (try-log-line-type "WARNING: 95% of disk space used"))) + (assert-equal ____ (line condition)) + (assert-equal ____ (reason condition))) + (let ((condition (try-log-line-type 5555))) + (assert-equal 'string (____ condition)) + (assert-equal 5555 (____ condition))))) diff --git a/koans-solved/control-statements.lisp b/koans-solved/control-statements.lisp new file mode 100644 index 00000000..a5952854 --- /dev/null +++ b/koans-solved/control-statements.lisp @@ -0,0 +1,68 @@ +;;; 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. + +(define-test if + ;; IF only evaluates and returns one branch of a conditional expression. + (assert-equal ____ (if t :true :false)) + (assert-equal ____ (if nil :true :false)) + ;; This also applies to side effects that migh or might not be evaluated. + (let ((result)) + (if t + (setf result :true) + (setf result :false)) + (assert-equal ____ result) + (if nil + (setf result :true) + (setf result :false)) + (assert-equal ____ result))) + +(define-test when-unless + ;; WHEN and UNLESS are like one-branched IF statements. + (let ((when-result nil) + (when-numbers '()) + (unless-result nil) + (unless-numbers '())) + (dolist (x '(1 2 3 4 5 6 7 8 9 10)) + (when (> x 5) + (setf when-result x) + (push x when-numbers)) + (unless (> x 5) + (setf unless-result x) + (push x unless-numbers))) + (assert-equal ____ when-result) + (assert-equal ____ when-numbers) + (assert-equal ____ unless-result) + (assert-equal ____ unless-numbers))) + +(define-test and-short-circuit + ;; AND only evaluates forms until one evaluates to NIL. + (assert-equal ____ + (let ((x 0)) + (and + (setf x (+ 1 x)) + (setf x (+ 1 x)) + nil + (setf x (+ 1 x))) + x))) + +(define-test or-short-circuit + ;; AND only evaluates forms until one evaluates to non-NIL. + (assert-equal ____ + (let ((x 0)) + (or + (setf x (+ 1 x)) + (setf x (+ 1 x)) + nil + (setf x (+ 1 x))) + x))) diff --git a/koans-solved/dice-project.lisp b/koans-solved/dice-project.lisp new file mode 100644 index 00000000..e9a4a3d6 --- /dev/null +++ b/koans-solved/dice-project.lisp @@ -0,0 +1,91 @@ +;;; 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. + +;;; In this project, we are going to define a CLOS class representing a simple +;;; set of dice. There are only two operations on the dice: reading the dice +;;; values and re-rolling their values. + +(defclass dice-set () + ;; Fill in the blank with a proper slot definition. + (____)) + +(defmethod dice-values ((object dice-set)) + ____) + +(defmethod roll ((count integer) (object dice-set)) + ____) + +(define-test make-dice-set + (let ((dice (make-instance 'dice-set))) + (assert-true (type-of dice 'dice-set)))) + +(define-test dice-are-six-sided + (let ((dice (make-instance 'dice-set))) + (roll 5 dice) + (assert-true (typep (dice-values dice) 'list)) + (assert-equal 5 (length (dice-values dice))) + (dolist (die (dice-values dice)) + (assert-true (typep die '(integer 1 6)))))) + +(define-test dice-values-do-not-change-without-rolling + (let ((dice (make-instance 'dice-set))) + (roll 100 dice) + (let ((dice-values-1 (dice-values dice)) + (dice-values-2 (dice-values dice))) + (assert-equal dice-values-1 dice-values-2)))) + +(define-test roll-returns-new-dice-values + (let* ((dice (make-instance 'dice-set)) + (dice-values (roll 100 dice))) + (assert-true (equal dice-values (dice-values dice))))) + +(define-test dice-values-should-change-between-rolling + (let* ((dice (make-instance 'dice-set)) + (first-time (roll 100 dice)) + (second-time (roll 100 dice))) + (assert-false (equal first-time second-time)) + (assert-true (equal second-time (dice-values dice))))) + +(define-test different-dice-sets-have-different-values + (let* ((dice-1 (make-instance 'dice-set)) + (dice-2 (make-instance 'dice-set))) + (roll 100 dice-1) + (roll 100 dice-2) + (assert-false (equal (dice-values dice-1) (dice-values dice-2))))) + +(define-test different-numbers-of-dice + (let ((dice (make-instance 'dice-set))) + (assert-equal 5 (length (roll 5 dice))) + (assert-equal 100 (length (roll 100 dice))) + (assert-equal 1 (length (roll 1 dice))))) + +(define-test junk-as-dice-count + (let ((dice (make-instance 'dice-set))) + (labels ((dice-failure (count) + (handler-case (progn (roll-dice count dice) + (error "Test failure")) + (error (condition) condition))) + (test-dice-failure (value) + (let* ((condition (dice-failure value)) + (expected-type (type-error-expected-type condition))) + (assert-true (typep condition 'type-error)) + (assert-equal value (type-error-datum)) + (assert-true (subtypep expected-type '(integer 1 6))) + (assert-true (subtypep '(integer 1 6) expected-type))))) + (test-dice-failure 0) + (test-dice-failure "0") + (test-dice-failure :zero) + (test-dice-failure 18.0) + (test-dice-failure -7) + (test-dice-failure '(6 6 6))))) diff --git a/koans-solved/equality-distinctions.lisp b/koans-solved/equality-distinctions.lisp new file mode 100644 index 00000000..becd7028 --- /dev/null +++ b/koans-solved/equality-distinctions.lisp @@ -0,0 +1,121 @@ +;;; 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. + +;;; The most common equality predicates in Common Lisp are, in order of +;;; strictness, EQ, EQL, EQUAL, and EQUALP. + +(define-test eq + ;; EQ checks the identity of the two objects; it checks whether the two + ;; objects are, in fact, one and the same object. + ;; It is the fastest of the four; however, not guaranteed to work on numbers + ;; and characters because of that. + (true-or-false? t (eq 'a 'a)) + (true-or-false? nil (eq 3 3.0)) + (true-or-false? nil (eq '(1 2) '(1 2))) + (true-or-false? nil (eq "Foo" "Foo")) + (true-or-false? nil (eq "Foo" (copy-seq "Foo"))) + (true-or-false? nil (eq "FOO" "Foo"))) + +(define-test eql + ;; EQL works like EQ, except it is specified to work for numbers and + ;; characters. + ;; Two numbers are EQL if they are of the same type and represent the same + ;; number. Two characters are EQL if they represent the same character. + (true-or-false? t (eql 'a 'a)) + (true-or-false? t (eql 3 3)) + (true-or-false? nil (eql 3 3.0)) + (true-or-false? nil (eql '(1 2) '(1 2))) + (true-or-false? nil (eql '(:a . :b) '(:a . :b))) + (true-or-false? t (eql #\S #\S)) + (true-or-false? nil (eql "Foo" "Foo")) + (true-or-false? nil (eql "Foo" (copy-seq "Foo"))) + (true-or-false? nil (eql "FOO" "Foo"))) + +(define-test equal + ;; EQUAL works like EQL, except works differently for lists, strings, bit + ;; vectors, and pathnames. + ;; Two lists, strings, bit arrays, or pathnames are EQUAL if they have EQUAL + ;; elements. + (true-or-false? t (equal 'a 'a)) + (true-or-false? t (equal 3 3)) + (true-or-false? nil (equal 3 3.0)) + (true-or-false? t (equal '(1 2) '(1 2))) + (true-or-false? t (equal '(:a . :b) '(:a . :b))) + (true-or-false? nil (equal '(:a . :b) '(:a . :doesnt-match))) + (true-or-false? t (equal #\S #\S)) + (true-or-false? t (equal "Foo" "Foo")) + (true-or-false? t (equal #*01010101 #*01010101)) + (true-or-false? t (equal "Foo" (copy-seq "Foo"))) + (true-or-false? nil (equal "FOO" "Foo")) + (true-or-false? t (equal #p"foo/bar/baz" #p"foo/bar/baz"))) + +(defstruct thing slot-1 slot-2) + +(define-test equalp + ;; EQUALP works like EQUAL, except it works differently for characters, + ;; numbers, arrays, structures, and hash tables. + ;; Two characters are EQUALP if they represent the same character, ignoring + ;; the differences in character case. + ;; Two numbers are EQUALP if they represent the same number, even if they are + ;; of different types. + ;; Two arrays are EQUALP if they have the same dimensions and their characters + ;; are pairwise EQUALP. + ;; Two structures are EQUALP if they are of the same class and their slots are + ;; pairwise EQUALP. + ;; We will contemplate hash tables in the HASH-TABLES lesson. + (true-or-false? t (equalp 'a 'a)) + (true-or-false? t (equalp 3 3)) + (true-or-false? t (equalp 3 3.0)) + (true-or-false? t (equalp '(1 2) '(1 2))) + (true-or-false? t (equalp '(:a . :b) '(:a . :b))) + (true-or-false? nil (equalp '(:a . :b) '(:a . :doesnt-match))) + (true-or-false? t (equalp #\S #\S)) + (true-or-false? t (equalp "Foo" "Foo")) + (true-or-false? t (equalp "Foo" (copy-seq "Foo"))) + (true-or-false? t (equalp "FOO" "Foo")) + (true-or-false? t (equalp (make-array '(4 2) :initial-element 0) + (make-array '(4 2) :initial-element 0))) + (true-or-false? t (equalp (make-thing :slot-1 42 :slot-2 :forty-two) + (make-thing :slot-1 42 :slot-2 :forty-two)))) + +;;; In additional to the generic equality predicates, Lisp also provides +;;; type-specific predicates for numbers, strings, and characters. + +(define-test = + ;; The function = behaves just like EQUALP on numbers. + ;; #C(... ...) is syntax sugar for creating a complex number. + (true-or-false? t (= 99.0 99 99.000 #C(99 0) #C(99.0 0.0))) + (true-or-false? nil (= 0 1 -1)) + (true-or-false? t (= (/ 2 3) (/ 6 9) (/ 86 129)))) + +(define-test string= + ;; The function STRING= behaves just like EQUAL on strings. + ;; The function STRING-EQUAL behaves just like EQUALP on strings. + (true-or-false? t (string= "Foo" "Foo")) + (true-or-false? nil (string= "Foo" "FOO")) + (true-or-false? t (string-equal "Foo" "FOO")) + ;; These functions accept additional keyword arguments that allow one to + ;; only compare parts of the strings. + (true-or-false? t (string= "together" "frog" :start1 1 :end1 3 + :start2 2)) + (true-or-false? t (string-equal "together" "FROG" :start1 1 :end1 3 + :start2 2))) + +(define-test char= + ;; The function CHAR= behaves just like EQL on characters. + ;; The function CHAR-EQUAL behaves just like EQUALP on characters. + (true-or-false? t (char= #\A (char "ABCDEF" 0))) + (true-or-false? nil (char= #\A #\a)) + (true-or-false? t (char-equal #\A (char "ABCDEF" 0))) + (true-or-false? t (char-equal #\A #\a))) diff --git a/koans-solved/evaluation.lisp b/koans-solved/evaluation.lisp new file mode 100644 index 00000000..709f3e08 --- /dev/null +++ b/koans-solved/evaluation.lisp @@ -0,0 +1,66 @@ +;;; 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. + +;;; In most imperative languages, the syntax of a function call has the function +;;; name succeeded by a list of arguments. In Lisp, the function name and +;;; arguments are all part of the same list, with the function name the first +;;; element of that list. + +(define-test function-names + ;; In these examples, +, -, *, and / are function names. + (assert-equal 5 (+ 2 3)) + (assert-equal -2 (- 1 3)) + (assert-equal 28 (* 7 4)) + (assert-equal 25 (/ 100 4))) + +(define-test numberp + ;; NUMBERP is a predicate which returns true if its argument is a number. + (assert-equal t (numberp 5)) + (assert-equal t (numberp 2.0)) + (assert-equal nil (numberp "five"))) + +(define-test evaluation-order + ;; Arguments to a function are evaluated before the function is called. + (assert-equal 9 (* (+ 1 2) (- 13 10)))) + +(define-test basic-comparisons + ;; The below functions are boolean functions (predicates) that operate on + ;; numbers. + (assert-equal t (> 25 4)) + (assert-equal nil (< 8 2)) + (assert-equal t (= 3 3)) + (assert-equal t (<= 6 (/ 12 2))) + (assert-equal t (>= 20 (+ 1 2 3 4 5))) + (assert-equal t (/= 15 (+ 4 10)))) + +(define-test quote + ;; Preceding a list with a quote (') will tell Lisp not to evaluate a list. + ;; The quote special form suppresses normal evaluation, and instead returns + ;; the literal list. + ;; Evaluating the form (+ 1 2) returns the number 3, but evaluating the form + ;; '(+ 1 2) returns the list (+ 1 2). + (assert-equal 3 (+ 1 2)) + (assert-equal '(+ 1 2) '(+ 1 2)) + (assert-equal '(+ 1 2) (list '+ 1 2)) + ;; The 'X syntax is syntactic sugar for (QUOTE X). + (true-or-false? t (equal '(/ 4 0) (quote (/ 4 0))))) + +(define-test listp + ;; LISTP is a predicate which returns true if the argument is a list. + (assert-equal t (listp '(1 2 3))) + (assert-equal nil (listp 100)) + (assert-equal nil (listp "Hello world")) + (assert-equal t (listp nil)) + (assert-equal nil (listp (+ 1 2))) + (assert-equal t (listp '(+ 1 2)))) diff --git a/koans-solved/extra-credit.lisp b/koans-solved/extra-credit.lisp new file mode 100644 index 00000000..0e4be3f4 --- /dev/null +++ b/koans-solved/extra-credit.lisp @@ -0,0 +1,9 @@ +;;; EXTRA CREDIT: +;;; +;;; Create a program that will play the Greed game. +;;; The full rules for the game are in the file extra-credit.txt. +;;; +;;; You already have a DICE-SET class and a score function you can use. +;;; Write a PLAYER class and a GAME class to complete the project. +;;; +;;; This is a free form assignment, so approach it however you desire. diff --git a/koans-solved/extra-credit.txt b/koans-solved/extra-credit.txt new file mode 100644 index 00000000..58b5a9cb --- /dev/null +++ b/koans-solved/extra-credit.txt @@ -0,0 +1,66 @@ += Playing Greed + +Greed is a dice game played among 2 or more players, using 5 +six-sided dice. + +== Playing Greed + +Each player takes a turn consisting of one or more rolls of the dice. +On the first roll of the game, a player rolls all five dice which are +scored according to the following: + + Three 1's => 1000 points + Three 6's => 600 points + Three 5's => 500 points + Three 4's => 400 points + Three 3's => 300 points + Three 2's => 200 points + One 1 => 100 points + One 5 => 50 points + +A single die can only be counted once in each roll. For example, +a "5" can only count as part of a triplet (contributing to the 500 +points) or as a single 50 points, but not both in the same roll. + +Example Scoring + + Throw Score + --------- ------------------ + 5 1 3 4 1 50 + 2 * 100 = 250 + 1 1 1 3 1 1000 + 100 = 1100 + 2 4 4 5 4 400 + 50 = 450 + +The dice not contributing to the score are called the non-scoring +dice. "3" and "4" are non-scoring dice in the first example. "3" is +a non-scoring die in the second, and "2" is a non-score die in the +final example. + +After a player rolls and the score is calculated, the scoring dice are +removed and the player has the option of rolling again using only the +non-scoring dice. If all of the thrown dice are scoring, then the +player may roll all 5 dice in the next roll. + +The player may continue to roll as long as each roll scores points. If +a roll has zero points, then the player loses not only their turn, but +also accumulated score for that turn. If a player decides to stop +rolling before rolling a zero-point roll, then the accumulated points +for the turn is added to his total score. + +== Getting "In The Game" + +Before a player is allowed to accumulate points, they must get at +least 300 points in a single turn. Once they have achieved 300 points +in a single turn, the points earned in that turn and each following +turn will be counted toward their total score. + +== End Game + +Once a player reaches 3000 (or more) points, the game enters the final +round where each of the other players gets one more turn. The winner +is the player with the highest score after the final round. + +== References + +Greed is described on Wikipedia at +http://en.wikipedia.org/wiki/Greed_(dice_game), however the rules are +a bit different from the rules given here. diff --git a/koans-solved/format.lisp b/koans-solved/format.lisp new file mode 100644 index 00000000..39d0e6fa --- /dev/null +++ b/koans-solved/format.lisp @@ -0,0 +1,84 @@ +;;; 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. + +;;; The function FORMAT is used to create formatted output. It is similar to +;;; the C function printf(). +;;; See http://www.gigamonkeys.com/book/a-few-format-recipes.html + +;;; T as the first argument to FORMAT prints the string to standard output. +;;; NIL as the first argument to FORMAT causes it to return the string. + +(define-test format-basic + ;; If there are no format directives in the string, FORMAT will return + ;; a string that is STRING= to its format control. + (assert-equal ____ (format nil "Lorem ipsum dolor sit amet"))) + +(define-test format-aesthetic + ;; The ~A format directive creates aesthetic output. + (assert-equal ____ (format nil "This is the number ~A" 42)) + (assert-equal ____ (format nil "This is the keyword ~A" :foo)) + (assert-equal ____ (format nil "~A evaluates to ~A" + '(/ 24 (- 3 (/ 8 3))) + (/ 24 (- 3 (/ 8 3))))) + (assert-equal ____ (format nil "This is the character ~A" #\C)) + (assert-equal ____ (format nil "In a ~A" "galaxy far far away"))) + +(define-test format-standard + ;; The ~S format directive prints objects with escape characters. + ;; Not all Lisp objects require to be escaped. + (assert-equal ____ (format nil "This is the number ~S" 42)) + (assert-equal ____ (format nil "~S evaluates to ~S" + '(/ 24 (- 3 (/ 8 3))) + (/ 24 (- 3 (/ 8 3))))) + ;; Keywords are printed with their leading colon. + (assert-equal ____ (format nil "This is the keyword ~S" :foo)) + ;; Characters are printed in their #\X form. The backslash will need to be + ;; escaped inside the printed string, just like in "#\\X". + (assert-equal ____ (format nil "This is the character ~S" #\C)) + ;; Strings include quote characters, which must be escaped: + ;; such a string might look in code like "foo \"bar\"". + (assert-equal ____ (format nil "In a ~S" "galaxy far far away"))) + +(define-test format-radix + ;; The ~B, ~O, ~D, and ~X radices print numbers in binary, octal, decimal, and + ;; hexadecimal notation. + (assert-equal ____ (format nil "This is the number ~B" 42)) + (assert-equal ____ (format nil "This is the number ~O" 42)) + (assert-equal ____ (format nil "This is the number ~D" 42)) + (assert-equal ____ (format nil "This is the number ~X" 42)) + ;; We can specify a custom radix by using the ~R directive. + (assert-equal ____ (format nil "This is the number ~3R" 42)) + ;; It is possible to print whole forms this way. + (let ((form '(/ 24 (- 3 (/ 8 3)))) + (result (/ 24 (- 3 (/ 8 3))))) + (assert-equal ____ (format nil "~B evaluates to ~B" form result)) + (assert-equal ____ (format nil "~O evaluates to ~O" form result)) + (assert-equal ____ (format nil "~D evaluates to ~D" form result)) + (assert-equal ____ (format nil "~X evaluates to ~X" form result)) + (assert-equal ____ (format nil "~3R evaluates to ~3R" form result)))) + +(define-test format-iteration + ;; The ~{ and ~} directives iterate over a list. + (assert-equal ____ (format nil "~{[~A]~}" '(1 2 3 4 5 6))) + (assert-equal ____ (format nil "~{[~A ~A]~}" '(1 2 3 4 5 6))) + ;; The directive ~^ aborts iteration when no more elements remain. + (assert-equal ____ (format nil "~{[~A]~^, ~}" '(1 2 3 4 5 6)))) + +(define-test format-case + ;; The ~( and ~) directives adjust the string case. + (assert-equal ____ (format nil "~(~A~)" "The QuIcK BROWN fox")) + ;; Some FORMAT directives can be further adjusted with the : and @ modifiers. + (assert-equal ____ (format nil "~:(~A~)" "The QuIcK BROWN fox")) + (assert-equal ____ (format nil "~@(~A~)" "The QuIcK BROWN fox")) + (assert-equal ____ (format nil "~:@(~A~)" "The QuIcK BROWN fox"))) diff --git a/koans-solved/functions.lisp b/koans-solved/functions.lisp new file mode 100644 index 00000000..2b757aa9 --- /dev/null +++ b/koans-solved/functions.lisp @@ -0,0 +1,184 @@ +;;; 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. + +(defun some-named-function (a b) + (+ a b)) + +(define-test call-a-function + ;; DEFUN can be used to define global functions. + (assert-equal 9 (some-named-function 4 5)) + ;; FLET can be used to define local functions. + (flet ((another-named-function (a b) (* a b))) + (assert-equal 20 (another-named-function 4 5))) + ;; LABELS can be used to define local functions which can refer to themselves + ;; or each other. + (labels ((recursive-function (a b) + (if (or (= 0 a) (= 0 b)) + 1 + (+ (* a b) (recursive-function (1- a) (1- b)))))) + (assert-equal 41 (recursive-function 4 5)))) + +(define-test shadow-a-function + (assert-eq 18 (some-named-function 7 11)) + ;; FLET and LABELS can shadow function definitions. + (flet ((some-named-function (a b) (* a b))) + (assert-equal 77 (some-named-function 7 11))) + (assert-equal 18 (some-named-function 7 11))) + +(defun function-with-optional-parameters (&optional (a 2) (b 3) c) + ;; If an optional argument to a function is not provided, it is given its + ;; default value, or NIL, if no default value is specified. + (list a b c)) + +(define-test optional-parameters + (assert-equal '(42 24 4224) (function-with-optional-parameters 42 24 4224)) + (assert-equal '(42 24 nil) (function-with-optional-parameters 42 24)) + (assert-equal '(42 3 nil) (function-with-optional-parameters 42)) + (assert-equal '(2 3 nil) (function-with-optional-parameters))) + +(defun function-with-optional-indication + (&optional (a 2 a-provided-p) (b 3 b-provided-p)) + ;; It is possible to check whether an optional argument was provided. + (list a a-provided-p b b-provided-p)) + +(define-test optional-indication + (assert-equal '(42 t 24 t) (function-with-optional-indication 42 24)) + (assert-equal '(42 t 3 nil) (function-with-optional-indication 42)) + (assert-equal '(2 nil 3 nil) (function-with-optional-indication))) + +(defun function-with-rest-parameter (&rest x) + ;; A rest parameter gathers all remaining parameters in a list. + x) + +(define-test rest-parameter + (assert-equal '() (function-with-rest-parameter)) + (assert-equal '(1) (function-with-rest-parameter 1)) + (assert-equal '(1 :two 333) (function-with-rest-parameter 1 :two 333))) + +(defun function-with-keyword-parameters (&key (a :something) b c) + ;; A keyword parameters is similar to an optional parameter, but is provided + ;; by a keyword-value pair. + (list a b c)) + +(define-test keyword-parameters () + (assert-equal '(:something nil nil) (function-with-keyword-parameters)) + (assert-equal '(11 22 33) (function-with-keyword-parameters :a 11 :b 22 :c 33)) + ;; It is not necessary to specify all keyword parameters. + (assert-equal '(:something 22 nil) (function-with-keyword-parameters :b 22)) + ;; Keyword argument order is not important. + (assert-equal '(0 22 -5/2) + (function-with-keyword-parameters :b 22 :c -5/2 :a 0)) + ;; Lisp handles duplicate keyword parameters. + (assert-equal '(:something 22 nil) + (function-with-keyword-parameters :b 22 :b 40 :b 812))) + +(defun function-with-keyword-indication + (&key (a 2 a-provided-p) (b 3 b-provided-p)) + ;; It is possible to check whether a keyword argument was provided. + (list a a-provided-p b b-provided-p)) + +(define-test keyword-indication + (assert-equal '(2 nil 3 nil) (function-with-keyword-indication)) + (assert-equal '(3 t 4 t) (function-with-keyword-indication :a 3 :b 4)) + (assert-equal '(11 t 22 t) (function-with-keyword-indication :a 11 :b 22)) + (assert-equal '(2 nil 22 t) (function-with-keyword-indication :b 22)) + (assert-equal '(0 t 22 t) (function-with-keyword-indication :b 22 :a 0))) + +(defun function-with-funky-parameters (a &rest x &key b (c a c-provided-p)) + ;; Lisp functions can have surprisingly complex lambda lists. + ;; A &rest parameter must come before &key parameters. + (list a b c c-provided-p x)) + +(define-test funky-parameters + (assert-equal '(1 nil 1 nil nil) (function-with-funky-parameters 1)) + (assert-equal '(1 2 1 nil (:b 2)) (function-with-funky-parameters 1 :b 2)) + (assert-equal '(1 2 3 t (:b 2 :c 3)) + (function-with-funky-parameters 1 :b 2 :c 3)) + (assert-equal '(1 2 3 t (:c 3 :b 2)) + (function-with-funky-parameters 1 :c 3 :b 2))) + +(define-test lambda + ;; A list form starting with the symbol LAMBDA denotes an anonymous function. + ;; It is possible to call that function immediately or to store it for later + ;; use. + (let ((my-function (lambda (a b) (* a b)))) + (assert-equal 99 (funcall my-function 11 9))) + ;; A LAMBDA form is allowed to take the place of a function name. + (assert-equal 19 ((lambda (a b) (+ a b)) 10 9)) + (let ((functions (list (lambda (a b) (+ a b)) + (lambda (a b) (- a b)) + (lambda (a b) (* a b)) + (lambda (a b) (/ a b))))) + (assert-equal 35 (funcall (first functions) 2 33)) + (assert-equal -31 (funcall (second functions) 2 33)) + (assert-equal 66 (funcall (third functions) 2 33)) + (assert-equal 2/33 (funcall (fourth functions) 2 33)))) + +(define-test lambda-with-optional-parameters + (assert-equal 19 ((lambda (a &optional (b 100)) (+ a b)) 10 9)) + (assert-equal 110 ((lambda (a &optional (b 100)) (+ a b)) 10))) + +(defun make-adder (x) + ;; MAKE-ADDER will create a function that closes over the parameter X. + ;; The parameter will be remembered as a part of the environment of the + ;; returned function, which will continue refering to it. + (lambda (y) (+ x y))) + +(define-test lexical-closures + (let ((adder-100 (make-adder 100)) + (adder-500 (make-adder 500))) + ;; ADD-100 and ADD-500 now close over different values. + (assert-equal 103 (funcall adder-100 3)) + (assert-equal 503 (funcall adder-500 3)))) + +(defun make-reader-and-writer (x) + ;; Both returned functions will refer to the same place. + (list (function (lambda () x)) + (function (lambda (y) (setq x y))))) + +(define-test lexical-closure-interactions + ;; The macro DESTRUCTURING-BIND is like LET, except it binds the variables + ;; listed in its first argument to the parts of the list returned by the form + ;; that is its second argument. + (destructuring-bind (reader-1 writer-1) (make-reader-and-writer 1) + (destructuring-bind (reader-2 writer-2) (make-reader-and-writer :one) + (assert-equal 1 (funcall reader-1)) + (funcall writer-1 0) + (assert-equal 0 (funcall reader-1)) + ;; The two different function pairs refer to different places. + (assert-equal :one (funcall reader-2)) + (funcall writer-2 :zero) + (assert-equal :zero (funcall reader-2))))) + +(define-test apply + ;; The function APPLY applies a function to a list of arguments. + (let ((function (lambda (x y z) (+ x y z)))) + (assert-equal 123 (apply function '(100 20 3)))) + ;; FUNCTION is a special operator that retrieves function objects, defined + ;; both globally and locally. #'X is syntax sugar for (FUNCTION X). + (assert-equal 3 (apply (function +) '(1 2))) + (assert-equal -1 (apply #'- '(1 2))) + ;; Only the last argument to APPLY must be a list. + (assert-equal 6 (apply #'+ 1 2 '(3))) + (assert-equal 4 (apply #'max 1 2 3 4 '()))) + +(define-test funcall + ;; The function FUNCALL calls a function with arguments, not expecting a final + ;; list of arguments. + (let ((function (lambda (x y z) (+ x y z)))) + (assert-equal 321 (funcall function 300 20 1))) + (assert-equal 3 (funcall (function +) 1 2)) + (assert-equal -1 (funcall #'- 1 2)) + (assert-equal 6 (funcall #'+ 1 2 3)) + (assert-equal 4 (funcall #'max 1 2 3 4))) diff --git a/koans-solved/hash-tables.lisp b/koans-solved/hash-tables.lisp new file mode 100644 index 00000000..c0290b1e --- /dev/null +++ b/koans-solved/hash-tables.lisp @@ -0,0 +1,108 @@ +;;; 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. + +;;; A hash table data structure is sometimes known as a dictionary. + +(define-test make-hash-table + (let ((my-hash-table (make-hash-table))) + (true-or-false? t (typep my-hash-table 'hash-table)) + (true-or-false? t (hash-table-p my-hash-table)) + (true-or-false? nil (hash-table-p (make-array '(3 3 3)))) + ;; The function HASH-TABLE-COUNT returns the number of entries currently + ;; contained in a hash table. + (assert-equal 0 (hash-table-count my-hash-table)))) + +(define-test gethash + ;; The function GETHASH can be used to access hash table values. + (let ((cube-roots (make-hash-table))) + ;; We add the key-value pair 1 - "uno" to the hash table. + (setf (gethash 1 cube-roots) "uno") + (assert-equal "uno" (gethash 1 cube-roots)) + (assert-equal 1 (hash-table-count cube-roots)) + (setf (gethash 8 cube-roots) 2) + (setf (gethash -3 cube-roots) -27) + (assert-equal -27 (gethash -3 cube-roots)) + (assert-equal 3 (hash-table-count cube-roots)) + ;; GETHASH returns a secondary value that is true if the key was found in + ;; the hash-table and false otherwise. + (multiple-value-bind (value foundp) (gethash 8 cube-roots) + (assert-equal 2 value) + (assert-equal t foundp)) + (multiple-value-bind (value foundp) (gethash 125 cube-roots) + (assert-equal nil value) + (assert-equal nil foundp)))) + +(define-test hash-table-test + ;; A hash table can be constructed with different test predicates. + ;; The programmer may choose between EQ, EQL, EQUAL, and EQUALP to get the + ;; best performance and expected results from the hash table. + ;; The default test predicate is EQL. + (let ((eq-table (make-hash-table :test #'eq)) + (eql-table (make-hash-table)) + (equal-table (make-hash-table :test #'equal)) + (equalp-table (make-hash-table :test #'equalp))) + ;; We will define four variables whose values are strings. + (let* ((string "one") + (same-string string) + (string-copy (copy-seq string)) + (string-upcased "ONE")) + ;; We will insert the value of each variable into each hash table. + (dolist (thing (list string same-string string-copy string-upcased)) + (dolist (hash-table (list eq-table eql-table equal-table equalp-table)) + (setf (gethash thing hash-table) t)))) + ;; How many entries does each hash table contain? + (assert-equal 3 (hash-table-count eq-table)) + (assert-equal 3 (hash-table-count eql-table)) + (assert-equal 2 (hash-table-count equal-table)) + (assert-equal 1 (hash-table-count equalp-table)))) + +(define-test hash-table-equality + ;; EQUALP considers two hash tables to be equal if they have the same test and + ;; if its key-value pairs are the same under that test. + (let ((hash-table-1 (make-hash-table :test #'equal)) + (hash-table-2 (make-hash-table :test #'equal))) + (setf (gethash "one" hash-table-1) "yat") + (setf (gethash "one" hash-table-2) "yat") + (setf (gethash "two" hash-table-1) "yi") + (setf (gethash "two" hash-table-2) "yi") + (true-or-false? nil (eq hash-table-1 hash-table-2)) + (true-or-false? nil (equal hash-table-1 hash-table-2)) + (true-or-false? t (equalp hash-table-1 hash-table-2)))) + +(define-test i-will-make-it-equalp + (let ((hash-table-1 (make-hash-table :test #'equal)) + (hash-table-2 (make-hash-table :test #'equal))) + (setf (gethash "one" hash-table-1) "uno" + (gethash "two" hash-table-1) "dos") + (setf (gethash "one" hash-table-2) "eins" + (gethash "two" hash-table-2) "zwei") + (assert-false (equalp hash-table-1 hash-table-2)) + ;; Change the first hash table to be EQUALP to the second one. + (setf (gethash "one" hash-table-1) "eins" + (gethash "two" hash-table-1) "zwei") + (assert-true (equalp hash-table-1 hash-table-2)))) + +(define-test make-your-own-hash-table + ;; Make your own hash table that satisfies the test. + (let ((colors (make-hash-table :test #'equal))) + ;; You will need to modify your hash table after you create it. + (setf (gethash "blue" colors) '(0 0 1) + (gethash "green" colors) '(0 1 0) + (gethash "red" colors) '(1 0 0) + (gethash "black" colors) '(0 0 0)) + (assert-equal (hash-table-count colors) 4) + (let ((values (list (gethash "blue" colors) + (gethash "green" colors) + (gethash "red" colors)))) + (assert-equal values '((0 0 1) (0 1 0) (1 0 0)))))) diff --git a/koans-solved/iteration.lisp b/koans-solved/iteration.lisp new file mode 100644 index 00000000..e820bc51 --- /dev/null +++ b/koans-solved/iteration.lisp @@ -0,0 +1,75 @@ +;;; 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. + +;;; Lisp has multiple options for iteration. +;;; This set of koans will introduce some of the most common ones. + +(define-test dolist + (let ((numbers '(4 8 15 16 23 42))) + ;; The macro DOLIST binds a variable to subsequent elements of a list. + (let ((sum 0)) + (dolist (number numbers) + ;; (INCF PLACE N) is equivalent to (SETF PLACE (+ N PLACE)). + (incf sum number)) + (assert-equal ____ sum)) + ;; DOLIST can optionally return a value. + (let ((sum 0)) + (assert-equal ____ (dolist (number numbers sum) + (incf sum number)))))) + +(define-test dotimes + ;; The macro DOTIMES binds a variable to subsequent integers from 0 to + ;; (1- COUNT). + (let ((stack '())) + (dotimes (i 5) + (push i stack)) + (assert-equal ____ stack)) + ;; DOTIMES can optionally return a value. + (let ((stack '())) + (assert-equal ____ (dotimes (i 5 stack) + (push i stack))))) + +(define-test do + ;; The macro DO accepts a list of variable bindings, a termination test with + ;; epilogue forms, and Lisp code that should be executed on each iteration. + (let ((result '())) + (do ((i 0 (1+ i))) + ((> i 5)) + (push i result)) + (assert-equal ____ result)) + ;; The epilogue of DO can return a value. + (let ((result (do ((i 0 (1+ i)) + ;; A variable bound by DO noes not need to be updated on + ;; each iteration. + (result '())) + ((> i 5) (nreverse result)) + (push i result)))) + (assert-equal ____ result))) + +(define-test loop-basic-form + ;; The macro LOOP in its simple form loops forever. It is possible to stop the + ;; looping by calling the RETURN special form. + (let ((counter 0)) + (loop (incf counter) + (when (>= counter 100) + (return counter))) + (assert-equal ___ loop-counter)) + ;; The RETURN special form can return a value out of a LOOP. + (let ((loop-counter 0)) + (assert-equal ___ (loop (incf counter) + (when (>= counter 100) + (return counter))))) + ;; The extended form of LOOP will be contemplated in a future koan. + ) + diff --git a/koans-solved/let.lisp b/koans-solved/let.lisp new file mode 100644 index 00000000..f3a47cbf --- /dev/null +++ b/koans-solved/let.lisp @@ -0,0 +1,62 @@ +;;; 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. + +(define-test let + ;; The LET form establishes a lexical extent within which new variables are + ;; created: a symbol that names a variable becomes bound to a value. + (let ((x 10) + (y 20)) + (assert-equal (+ x y) 30) + ;; It is possible to shadow previously visible bindings. + (let ((y 30)) + (assert-equal (+ x y) 40)) + (assert-equal (+ x y) 30)) + ;; Variables bound by LET have a default value of NIL. + (let (x) + (assert-equal x nil))) + +(define-test let-versus-let* + ;; LET* is similar to LET, except the bindings are established sequentially, + ;; and a binding may use bindings that were established before it. + (let ((x 10) + (y 20)) + (let ((x (+ y 100)) + (y (+ x 100))) + (assert-equal 120 x) + (assert-equal 110 y)) + (let* ((x (+ y 100)) + (y (+ x 100))) + ;; Which X is used to compute the value of Y? + (assert-equal 120 x) + (assert-equal 220 y)))) + +(define-test let-it-be-equal + ;; Fill in the LET and LET* to get the tests to pass. + (let ((a 1) + (b :two) + (c "Three")) + (let ((a 100) + (b 200) + (c "Jellyfish")) + (assert-equal a 100) + (assert-equal b 200) + (assert-equal c "Jellyfish")) + (let* ((a 121) + (b 200) + ;; In this third binding, you are allowed to use the variables bound + ;; by the previous two LET* bindings. + (c (+ a (/ b a)))) + (assert-equal a 121) + (assert-equal b 200) + (assert-equal c (+ a (/ b a)))))) diff --git a/koans-solved/lists.lisp b/koans-solved/lists.lisp new file mode 100644 index 00000000..95e1678a --- /dev/null +++ b/koans-solved/lists.lisp @@ -0,0 +1,146 @@ +;;; 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. + +;;; A singly linked list is the basic build block of Lisp. Each node of such a +;;; list is called a "cons cell" in Lisp. Each cons cell has two slots: a CAR, +;;; often used to hold an element of a list, and a CDR, often used to reference +;;; the next cons cell. + +(define-test how-to-make-lists + (let (;; Literal lists can be passed by quoting them. + (fruits '(orange pomello clementine)) + ;; Freshly constructed lists can be passed using the LIST function. + (some-evens (list (* 2 1) (* 2 2) (* 2 3))) + ;; Lists can also be passed using quotes and dot notation... + (long-numbers '(16487302 . (3826700034 . (10000000 . nil)))) + ;; ...or by using the function CONS. + (names (cons "Matthew" (cons "Mark" (cons "Margaret" '()))))) + ;; Try filling in the below blanks in different ways. + (assert-equal '(orange pomello clementine) fruits) + (assert-equal '(2 4 6) some-evens) + (assert-equal '(16487302 3826700034 10000000) long-numbers) + (assert-equal '("Matthew" "Mark" "Margaret") names))) + +(define-test cons-tructing-lists + ;; The function CONS can be used to add new elements at the beginning of + ;; an existing list. + (let ((nums '())) + (setf nums (cons :one nums)) + (assert-equal '(:one) nums) + (setf nums (cons :two nums)) + (assert-equal '(:two :one) nums) + ;; Lists can contain anything, even objects of different types. + (setf nums (cons 333 nums)) + (assert-equal '(333 :two :one) nums) + ;; Lists can contain other lists, too. + (setf nums (cons (list "some" "strings") nums)) + (assert-equal '(("some" "strings") 333 :two :one) nums))) + +(define-test car-and-cdr + ;; We may use functions CAR and CDR (or, alternatively, FIRST and REST) to + ;; access the two slots of a cons cell. + (let ((x (cons 1 2))) + (assert-equal 1 (car x)) + (assert-equal 2 (cdr x))) + ;; Calls to CAR and CDR are often intertwined to extract data from a nested + ;; cons structure. + (let ((structure '((1 2) (("foo" . "bar"))))) + (assert-equal '(1 2) (car structure)) + (assert-equal '(("foo" . "bar")) (car (cdr structure))) + (assert-equal "bar" (cdr (car (car (cdr structure))))) + ;; Lisp defines shorthand functions for up to four such nested calls. + (assert-equal '(1 2) (car structure)) + (assert-equal '(("foo" . "bar")) (cadr structure)) + (assert-equal "bar" (cdaadr structure)))) + +(define-test push-pop + ;; PUSH and POP are macros similar to SETF, as both of them operate on places. + (let ((place '(10 20 30 40))) + ;; PUSH sets the value of the place to a new cons cell containing some value + ;; in its CAR. + (push 0 place) + (assert-equal '(0 10 20 30 40) place) + ;; POP removes a single cons cell from a place, sets the place to its CDR, + ;; and returns the value from its CAR. + (let ((value (pop place))) + (assert-equal 0 value) + (assert-equal '(10 20 30 40) place)) + ;; The return value of POP can be discarded to simply "remove" a single cons + ;; cell from a place. + (pop place) + (let ((value (pop place))) + (assert-equal 20 value) + (assert-equal '(30 40) place)))) + +(define-test append-nconc + ;; The functions APPEND and NCONC appends one list to the end of another. + ;; While APPEND creates new lists, NCONC modifies existing ones; therefore + ;; APPEND can be used on literals, but NCONC needs fresh lists. + (assert-equal '(:a :b :c) (append '(:a :b) '(:c))) + (assert-equal '(:a :b :c) (nconc (list :a :b) (list :c))) + (let ((list-1 (list 1 2 3)) + (list-2 (list 4 5 6))) + ;; Both APPEND and NCONC return the appended list, but the interesting part + ;; is what happens when we try to use the original variables passed to them. + (assert-equal '(1 2 3 4 5 6) (append list-1 list-2)) + (assert-equal '(1 2 3) list-1) + (assert-equal '(4 5 6) list-2) + (assert-equal '(1 2 3 4 5 6) (nconc list-1 list-2)) + (assert-equal '(1 2 3 4 5 6) list-1) + (assert-equal '(4 5 6) list-2))) + +(define-test accessing-list-elements + (let ((noms '("peanut" "butter" "and" "jelly"))) + ;; Common Lisp defines accessor functions for lists: FIRST, SECOND, ..., + ;; up to TENTH. + (assert-equal "peanut" (first noms)) + (assert-equal "butter" (second noms)) + (assert-equal "jelly" (fourth noms)) + ;; The function LAST returns the last cons cell of a list. + (assert-equal '("jelly") (last noms)) + ;; The function NTH returns the n-th element of a list. + (assert-equal "butter" (nth 1 noms)) + (assert-equal "peanut" (nth 0 noms)) + (assert-equal "jelly" (nth 3 noms)))) + +(define-test cons-tructing-improper-lists + ;; A proper list is a list whose final CDR ends with NIL. + ;; An improper list either has a non-NIL value in its final CDR or does not + ;; have a final CDR due to a cycle in its structure. + (let (;; We can construct non-cyclic improper lists using LIST*... + (x (list* 1 2 3 4 5)) + ;; ...or pass them as literals via dot notation. + (y '(6 7 8 9 . 0))) + (assert-equal '(4 . 5) (last x)) + (assert-equal '(9 . 0) (last y))) + ;; We can create a cyclic list by changing the last CDR of a list to refer to + ;; another cons cell + (let ((list (list 1 2 3 4 5)) + (cyclic-list (list 1 2 3 4 5))) + (setf (cdr (last cyclic-list)) cyclic-list) + ;; Function LIST-LENGTH returns NIL if a list is cyclic. + (assert-equal 5 (list-length list)) + (assert-equal nil (list-length cyclic-list)) + ;; Many Lisp functions operate only on proper lists. + ;; The function NTH is not one of them; it can be used to retrieve elements + ;; of cyclic lists. + (assert-equal 2 (nth 101 cyclic-list)))) + +(define-test slicing-lists + ;; The function SUBSEQ returns a subsequence of a list. + (let ((noms (list "peanut" "butter" "and" "jelly"))) + (assert-equal '("peanut") (subseq noms 0 1)) + (assert-equal '("peanut" "butter") (subseq noms 0 2)) + (assert-equal '() (subseq noms 2 2)) + (assert-equal '("and" "jelly") (subseq noms 2)))) diff --git a/koans-solved/loops.lisp b/koans-solved/loops.lisp new file mode 100644 index 00000000..85429bdd --- /dev/null +++ b/koans-solved/loops.lisp @@ -0,0 +1,140 @@ +;;; 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. + +;;; The extended for of LOOP allows for advanced iteration. +;;; See http://www.gigamonkeys.com/book/loop-for-black-belts.html + +(define-test loop-collect + ;; LOOP can collect the results in various ways. + (let* ((result-1 (loop for letter in '(#\a \b #\c #\d) collect letter)) + (result-2 (loop for number in '(1 2 3 4 5) sum number)) + (result-3 (loop for list in '((foo) (bar) (baz)) append list))) + (assert-equal ____ result-1) + (assert-equal ____ result-2) + (assert-equal ____ result-3))) + +(define-test loop-multiple-variables + ;; With multiple FOR clauses, the loop ends when any of the provided lists are + ;; exhausted. + (let* ((letters '(:a :b :c :d)) + (result (loop for letter in letters + for i from 1 to 1000 + collect (list i letter)))) + (assert-equal ____ result))) + +(define-test loop-in-versus-loop-on + ;; Instead of iterating over each element of a list, we can iterate over each + ;; cons cell of a list. + (let* ((letters '(:a :b :c)) + (result-in (loop for thing in letters collect thing)) + (result-on (loop for thing on letters collect thing))) + (assert-equal ____ result-in) + (assert-equal ____ result-on))) + +(define-test loop-for-by + ;; Numeric iteration can go faster or slower if we use the BY keyword. + (let* ((result (loop for i from 0 to 30 by 5 collect i))) + (assert-equal ____ result))) + +(define-test loop-counting-backwards + ;; We can count downwards instead of upwards by using DOWNTO instead of TO. + (let ((result (loop for i from 5 downto -5 collect i))) + (assert-equal ____ result))) + +(define-test loop-list-by + ;; List iteration can go faster or slower if we use the BY keyword. + (let* ((letters '(:a :b :c :d :e :f)) + (result (loop for letter in letters collect letter)) + (result-cdr (loop for letter in letters by #'cdr collect letter)) + (result-cddr (loop for letter in letters by #'cddr collect letter)) + (result-cdddr (loop for letter in letters by #'cdddr collect letter))) + (assert-equal ____ result-in) + (assert-equal ____ result-in-cdr) + (assert-equal ____ result-in-cddr) + (assert-equal ____ result-in-cdddr))) + +(define-test loop-across + ;; LOOP can iterate over a vector with the ACROSS keyword. + (let* ((vector (make-array '(5) :initial-contents '(0 1 2 3 4))) + (result (loop for number across vector collect number))) + (assert-equal ____ result))) + +(define-test loop-over-2d-array + (let ((array (make-array '(3 2) :initial-contents '((0 1) (2 3) (4 5))))) + ;; LOOP can be combined with ROW-MAJOR-AREF to iterate over the contents of + ;; a multidimensional array. + (let* ((result (loop for i from 0 below (array-total-size array) + collect (row-major-aref my-array i)))) + (assert-equal ____ result)) + ;; It is always possible to resort to nested loops. + (let* ((result (loop with max-i = (array-dimension array 0) + for i from 0 below max-i + collect (loop with max-j = (array-dimension array 1) + for j from 0 below max-j + collect (expt (aref my-array i j) 2))))) + (assert-equal ____ result)))) + +(define-test loop-hash-table + (let ((book-heroes (make-hash-table :test 'equal))) + (setf (gethash "The Hobbit" book-heroes) "Bilbo" + (gethash "Where The Wild Things Are" book-heroes) "Max" + (gethash "The Wizard Of Oz" book-heroes) "Dorothy" + (gethash "The Great Gatsby" book-heroes) "James Gatz") + ;; LOOP can iterate over hash tables. + (let (pairs-in-table (loop for key being the hash-key of book-heroes + using (hash-value value) + collect (list key value))) + (assert-equal ____ (length pairs-in-table)) + (true-or-false? ____ (find '("The Hobbit" "Bilbo") pairs-in-table + :test #'equal))))) + +(define-test loop-statistics + ;; LOOP can perform basics statistics on the collected elements. + (let ((result (loop for x in '(1 2 4 8 16 32) + collect x into collected + count x into counted + sum x into summed + maximize x into maximized + minimize x into minimized + finally (return (list collected counted summed + maximized minimized))))) + (destructuring-bind (collected counted summed maximized minimized) result + (assert-equal ____ collected) + (assert-equal ____ counted) + (assert-equal ____ summed) + (assert-equal ____ maximized) + (assert-equal ____ minimized)))) + +(define-test loop-destructuring + ;; LOOP can bind multiple variables on each iteration step. + (let* ((count 0) + (result (loop for (a b) in '((1 9) (2 8) (3 7) (4 6)) + do (incf count) + collect (+ a b)))) + (assert-equal ____ count) + (assert-equal ____ result))) + +(define-test conditional-execution + (let ((numbers '(1 1 2 3 5 8 13 21))) + ;; LOOP can execute some actions conditionally. + (let ((result (loop for x in numbers + when (evenp x) sum x))) + (assert-equal ____ result)) + (let ((result (loop for x in numbers + unless (evenp x) sum x))) + (assert-equal ____ result)) + (flet ((greater-than-10-p (x) (> x 10))) + (let ((result (loop for x in numbers + when (greater-than-10-p 10) sum x))) + (assert-equal ____ result))))) diff --git a/koans-solved/macros.lisp b/koans-solved/macros.lisp new file mode 100644 index 00000000..f4f9e607 --- /dev/null +++ b/koans-solved/macros.lisp @@ -0,0 +1,116 @@ +;;; 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. + +;;; A Lisp macro is a function that accepts Lisp data and produces a Lisp form. +;;; When the macro is called, its macro function receives unevaluated arguments +;;; and may use them to produce a new Lisp form. This form is then spliced in +;;; place of the original macro call and is then evaluated. + +(defmacro my-and (&rest forms) + ;; We use a LABELS local function to allow for recursive expansion. + (labels ((generate (forms) + (cond ((null forms) 'nil) + ((null (rest forms)) (first forms)) + (t `(when ,(first forms) + ,(generate (rest forms))))))) + (generate forms))) + +(define-test my-and + ;; ASSERT-EXPANDS macroexpands the first form once and checks if it is equal + ;; to the second form. + (assert-expands (my-and (= 0 (random 6)) (error "Bang!")) + (when (= 0 (random 6)) (error "Bang!"))) + (assert-expands (my-and (= 0 (random 6)) + (= 0 (random 6)) + (= 0 (random 6)) + (error "Bang!")) + ____)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; A common macro pitfall is capturing a variable defined by the user. + +(define-test variable-capture + (macrolet ((for ((var start stop) &body body) + `(do ((,var ,start (1+ ,var)) + (limit ,stop)) + ((> ,var limit)) + ,@body))) + (let ((limit 10) + (result '())) + (for (i 0 3) + (push i result) + (assert-equal ____ limit)) + (assert-equal ____ (nreverse result))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Another pitfall is evaluating some forms multiple times where they are only +;;; meant to be evaluated once. + +(define-test multiple-evaluation + ;; We use MACROLET for defining a local macro. + (macrolet ((for ((var start stop) &body body) + `(do ((,var ,start (1+ ,var))) + ((> ,var ,stop)) + ,@body))) + (let ((side-effects '()) + (result '())) + ;; Our functions RETURN-0 and RETURN-3 have side effects. + (flet ((return-0 () (push 0 side-effects) 0) + (return-3 () (push 3 side-effects) 3)) + (for (i (return-0) (return-3)) + (push i result))) + (assert-equal ____ (nreverse result)) + (assert-equal ____ (nreverse side-effects))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Yet another pitfall is not respecting the evaluation order of the macro +;;; subforms. + +(define-test wrong-evaluation-order + (macrolet ((for ((var start stop) &body body) + ;; The function GENSYM creates GENerated SYMbols, guaranteed to + ;; be unique in the whole Lisp system. Because of that, they + ;; cannot capture other symbols, preventing variable capture. + (let ((limit (gensym "LIMIT"))) + `(do ((,limit ,stop) + (,var ,start (1+ ,var))) + ((> ,var ,limit)) + ,@body)))) + (let ((side-effects '()) + (result '())) + (flet ((return-0 () (push 0 side-effects) 0) + (return-3 () (push 3 side-effects) 3)) + (for (i (return-0) (return-3)) + (push i result))) + (assert-equal ____ (nreverse result)) + (assert-equal ____ (nreverse side-effects))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-test for + (macrolet ((for ((var start stop) &body body) + ;; Fill in the blank with a correct FOR macroexpansion that is + ;; not affected by the three macro pitfalls mentioned above. + ____)) + (let ((side-effects '()) + (result '())) + (flet ((return-0 () (push 0 side-effects) 0) + (return-3 () (push 3 side-effects) 3)) + (for (i (return-0) (return-3)) + (push i result))) + (assert-equal '(0 1 2 3) (nreverse result)) + (assert-equal '(0 3) (nreverse side-effects))))) diff --git a/koans-solved/mapcar-and-reduce.lisp b/koans-solved/mapcar-and-reduce.lisp new file mode 100644 index 00000000..4df282a6 --- /dev/null +++ b/koans-solved/mapcar-and-reduce.lisp @@ -0,0 +1,97 @@ +;;; 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. + +;;; Lisp supports several functional alternatives to imperative iteration. + +(define-test mapcar + (let ((numbers '(1 2 3 4 5 6))) + ;; Inside MAPCAR, he function 1+ will be applied to each element of NUMBERS. + ;; A new list will be collected from the results. + (assert-equal '(2 3 4 5 6 7) (mapcar #'1+ numbers)) + (assert-equal ____ (mapcar #'- numbers)) + (assert-equal ____ (mapcar #'list numbers)) + (assert-equal ____ (mapcar #'evenp numbers)) + (assert-equal ____ (mapcar #'numberp numbers)) + (assert-equal ____ (mapcar #'stringp numbers)) + ;; MAPCAR can work on multiple lists. The function will receive one argument + ;; from each list. + (let (other-numbers '(4 8 15 16 23 42)) + (assert-equal ____ (mapcar #'+ numbers other-numbers)) + (assert-equal ____ (mapcar #'* numbers other-numbers)) + ;; The function MOD performs modulo division. + (assert-equal ____ (mapcar #'mod other-numbers numbers))))) + +(define-test mapcar-lambda + ;; MAPCAR is often used with anonymous functions. + (let ((numbers '(8 21 152 37 403 14 7 -34))) + (assert-equal ____ (mapcar (lambda (x) (mod x 10)) numbers))) + (let ((strings '("Mary had a little lamb" + "Old McDonald had a farm" + "Happy birthday to you"))) + (assert-equal ____ (mapcar (lambda (x) (subseq x 4 12)) strings)))) + +(define-test map + ;; MAP is a variant of MAPCAR that works on any sequences. + ;; It allows to specify the type of the resulting sequence. + (let ((string "lorem ipsum")) + (assert-equal ____ (map 'string #'char-upcase string)) + (assert-equal ____ (map 'list #'char-upcase string)) + ;; Not all vectors containing characters are strings. + (assert-equal ____ (map '(vector t) #'char-upcase string)))) + +(define-test transposition + ;; MAPCAR gives the function as many arguments as there are lists. + (flet ((transpose (lists) (apply #'mapcar ____ lists))) + (let ((list '((1 2 3) + (4 5 6) + (7 8 9))) + (transposed-list '((1 4 7) + (2 5 8) + (3 6 9))))) + (assert-equal transposed-list (transpose list)) + (assert-equal ____ (transpose (transpose list)))) + (assert-equal ____ (transpose '(("these" "making") + ("pretzels" "me") + ("are" "thirsty"))))) + +(define-test reduce + ;; The function REDUCE combines the elements of a list by applying a binary + ;; function to the elements of a sequence from left to right. + (assert-equal 15 (reduce #'+ '(1 2 3 4 5))) + (assert-equal ____ (reduce #'+ '(1 2 3 4))) + (assert-equal ____ (reduce #'expt '(1 2 3 4 5)))) + +(define-test reduce-from-end + ;; The :FROM-END keyword argument can be used to reduce from right to left. + (let ((numbers '(1 2 3 4 5))) + (assert-equal ____ (reduce #'cons numbers)) + (assert-equal ____ (reduce #'cons numbers :from-end t))) + (let ((numbers '(2 3 2))) + (assert-equal ____ (reduce #'expt numbers)) + (assert-equal ____ (reduce #'expt numbers :from-end t)))) + +(define-test reduce-initial-value + ;; :INITIAL-VALUE can supply the initial value for the reduction. + (let ((numbers '(1 2 3 4 5))) + (assert-equal ____ (reduce #'* numbers)) + (assert-equal ____ (reduce #'* numbers :initial-value 0)) + (assert-equal ____ (reduce #'* numbers :initial-value -1)))) + +(define-test inner-product + ;; MAPCAR and REDUCE are powerful when used together. + ;; Fill in the blanks to produce a local function that computes an inner + ;; product of two vectors. + (flet ((inner-product (x y) (reduce ____ (mapcar ____ x y)))) + (assert-equal 32 (inner-product '(1 2 3) '(4 5 6))) + (assert-equal 310 (inner-product '(10 20 30) '(4 3 7))))) diff --git a/koans-solved/multiple-values.lisp b/koans-solved/multiple-values.lisp new file mode 100644 index 00000000..511368d4 --- /dev/null +++ b/koans-solved/multiple-values.lisp @@ -0,0 +1,41 @@ +;;; 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. + +;;; In Lisp, it is possible for a function to return more than one value. +;;; This is distinct from returning a list or structure of values. + +(define-test multiple-values + (let ((x (floor 3/2)) + ;; The macro MULTIPLE-VALUE-LIST returns a list of all values returned + ;; by a Lisp form. + (y (multiple-value-list (floor 3/2)))) + (assert-equal x 1) + (assert-equal y '(1 1/2))) + (assert-equal '(24 3/4) (multiple-value-list (floor 99/4)))) + +(defun next-fib (a b) + ;; The function VALUES allows returning multiple values. + (values b (+ a b))) + +(define-test binding-and-setting-multiple-values + ;; The macro MULTIPLE-VALUE-BIND is like LET, except it binds the variables + ;; listed in its first argument to the values returned by the form that is its + ;; second argument. + (multiple-value-bind (x y) (next-fib 3 5) + (let ((result (* x y))) + (assert-equal 40 result))) + ;; SETF can also set multiple values if a VALUES form is provided as a place. + (let (x y) + (setf (values x y) (next-fib 5 8)) + (assert-equal '(8 13) (list x y)))) diff --git a/koans-solved/nil-false-empty.lisp b/koans-solved/nil-false-empty.lisp new file mode 100644 index 00000000..ebbd6ebd --- /dev/null +++ b/koans-solved/nil-false-empty.lisp @@ -0,0 +1,52 @@ +;;; 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. + +(define-test t-and-nil-are-opposites + ;; NOT is a function which returns the boolean opposite of its argument. + (true-or-false? t (not nil)) + (true-or-false? nil (not t))) + +(define-test nil-and-empty-list-are-the-same-thing + ;; In Common Lisp, NIL is also the empty list. + (true-or-false? nil '()) + (true-or-false? t (not '()))) + +(define-test in-lisp-many-things-are-true + ;; In Common Lisp, the canonical values for truth is T. + ;; However, everything that is non-NIL is true, too. + (true-or-false? t 5) + (true-or-false? nil (not 5)) + (true-or-false? t "a string") + ;; Even an empty string... + (true-or-false? t "") + ;; ...or a list containing a NIL... + (true-or-false? t (list nil)) + ;; ...or an array with no elements... + (true-or-false? t (make-array 0)) + ;; ...or the number zero. + (true-or-false? t 0)) + +(define-test and + ;; The logical operator AND can take multiple arguments. + (true-or-false? t (and t t t t t)) + (true-or-false? nil (and t t nil t t)) + ;; If all values passed to AND are true, it returns the last value. + (assert-equal 5 (and t t t t t 5))) + +(define-test or + ;; The logical operator OR can also take multiple arguments. + (true-or-false? t (or nil nil nil t nil)) + ;; OR returns the first non-NIL value it encounters, or NIL if there are none. + (assert-equal nil (or nil nil nil)) + (assert-equal 1 (or 1 2 3 4 5))) diff --git a/koans-solved/scope-and-extent.lisp b/koans-solved/scope-and-extent.lisp new file mode 100644 index 00000000..16c0aa62 --- /dev/null +++ b/koans-solved/scope-and-extent.lisp @@ -0,0 +1,48 @@ +;;; 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. + +(define-test shadowing + (assert-equal '(4 2) (let ((z 4)) (list z (let ((z 2)) z))))) + +(defun block-1 () + (block here + (return-from here 4) + 5)) + +(defun block-2 () + (block outer + (block inner + (return-from outer 'space) + (return-from inner 'tube)) + (return-from outer 'valve))) + +(define-test block-return-from + (assert-equal 4 (block-1)) + (assert-equal 'space (block-2))) + +;;; See http://www.gigamonkeys.com/book/variables.html + +(define-test lexical-variables-can-be-enclosed + (assert-equal 10 (let ((f (let ((x 10)) + (lambda () x)))) + (let ((x 20)) + (funcall f))))) + +(define-test dynamic-variables-are-affected-by-execution-path + (assert-equal 20 (let ((f (let ((x 10)) + (declare (special x)) + (lambda () x)))) + (let ((x 20)) + (declare (special x)) + (funcall f))))) diff --git a/koans-solved/scoring-project.lisp b/koans-solved/scoring-project.lisp new file mode 100644 index 00000000..33aea48a --- /dev/null +++ b/koans-solved/scoring-project.lisp @@ -0,0 +1,82 @@ +;;; 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. + +;;; Greed is a dice game played among 2 or more players, using 5 +;;; six-sided dice. +;;; +;;; Each player takes a turn consisting of one or more rolls of the dice. +;;; On the first roll of the game, a player rolls all five dice which are +;;; scored according to the following: +;;; +;;; Three 1's => 1000 points +;;; Three 6's => 600 points +;;; Three 5's => 500 points +;;; Three 4's => 400 points +;;; Three 3's => 300 points +;;; Three 2's => 200 points +;;; One 1 => 100 points +;;; One 5 => 50 points +;;; +;;; A single die can only be counted once in each roll. For example, +;;; a "5" can only count as part of a triplet (contributing to the 500 +;;; points) or as a single 50 points, but not both in the same roll. +;;; +;;; Example Scoring +;;; +;;; Throw Score +;;; --------- ------------------ +;;; 5 1 3 4 1 50 + 2 * 100 = 250 +;;; 1 1 1 3 1 1000 + 100 = 1100 +;;; 2 4 4 5 4 400 + 50 = 450 +;;; +;;; The dice not contributing to the score are called the non-scoring +;;; dice. "3" and "4" are non-scoring dice in the first example. "3" is +;;; a non-scoring die in the second, and "2" is a non-score die in the +;;; final example. +;;; +;;; More scoring examples are given in the tests below. +;;; +;;; Your goal is to write the scoring function for Greed. + +(defun score (&rest dice) + ____) + +(define-test score-of-an-empty-list-is-zero + (assert-equal 0 (score))) + +(define-test score-of-a-single-roll-of-5-is-50 + (assert-equal 50 (score 5))) + +(define-test score-of-a-single-roll-of-1-is-100 + (assert-equal 100 (score 1))) + +(define-test score-of-multiple-1s-and-5s-is-the-sum-of-individual-scores + (assert-equal 300 (score 1 5 5 1))) + +(define-test score-of-single-2s-3s-4s-and-6s-are-zero + (assert-equal 0 (score 2 3 4 6))) + +(define-test score-of-a-triple-1-is-1000 + (assert-equal 1000 (score 1 1 1))) + +(define-test score-of-other-triples-is-100x + (assert-equal 200 (score 2 2 2)) + (assert-equal 300 (score 3 3 3)) + (assert-equal 400 (score 4 4 4)) + (assert-equal 500 (score 5 5 5)) + (assert-equal 600 (score 6 6 6))) + +(define-test score-of-mixed-is-sum + (assert-equal 250 (score 2 5 2 2 3)) + (assert-equal 550 (score 5 5 5 5))) diff --git a/koans-solved/std-method-comb.lisp b/koans-solved/std-method-comb.lisp new file mode 100644 index 00000000..f456d35d --- /dev/null +++ b/koans-solved/std-method-comb.lisp @@ -0,0 +1,219 @@ +;;; 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 :reader value :initform :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))) + +(defmethod (setf value) :after ((object access-counter)) + (incf (slot-value object 'access-count))) + +(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)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; In addition to :BEFORE and :AFTER methods is also possible to write :AROUND +;;; methods, whose code executes around the primary method. In such context, it +;;; is possible to call the primary method via CALL-NEXT-METHOD. +;;; In the standard method combination, the :AFTER method, if one exists, is +;;; executed first, and it may choose whether and how to call next methods. + +(defgeneric grab-lollipop () + (:method () :lollipop)) + +(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))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(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 :value))) + +(defmethod remaining-time :around ((object countdown)) + (let ((value (call-next-method))) + (if (<= 0 value) + ;; DECF is similar to INCF. It decreases the value stored in the place + ;; and returns the decreased value. + (decf value) + :bang))) + +(define-test countdown + (let ((countdown (make-instance 'countdown :value 4))) + (assert-equal 3 (remaining-time countdown)) + (assert-equal 2 (remaining-time countdown)) + (assert-equal 1 (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 ____ (counter object))) + (let ((object (make-instance 'bigger-object))) + (frobnicate object) + (assert-equal ____ (counter object)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; 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)))) diff --git a/koans-solved/strings.lisp b/koans-solved/strings.lisp new file mode 100644 index 00000000..87a57eb9 --- /dev/null +++ b/koans-solved/strings.lisp @@ -0,0 +1,73 @@ +;;; 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. + +(define-test what-is-a-string + (let ((string "Do, or do not. There is no try.")) + (true-or-false? t (typep string 'string)) + ;; Strings are vectors of characters. + (true-or-false? t (typep string 'array)) + (true-or-false? t (typep string 'vector)) + (true-or-false? t (typep string '(vector character))) + (true-or-false? nil (typep string 'integer)))) + +(define-test multiline-string + ;; A Lisp string can span multiple lines. + (let ((string "this is + a multi + line string")) + (true-or-false? t (typep string 'string)))) + +(define-test escapes-in-strings + ;; Quotes and backslashes in Lisp strings must be escaped. + (let ((my-string "this string has one of these \" and a \\ in it")) + (true-or-false? t (typep my-string 'string)))) + +(define-test substrings + ;; Since strings are sequences, it is possible to use SUBSEQ on them. + (let ((string "Lorem ipsum dolor sit amet")) + (assert-equal "dolor sit amet" (subseq string 12)) + (assert-equal "ipsum" (subseq string 6 11)) + (assert-equal "orem" (subseq string 1 5)))) + +(define-test strings-versus-characters + ;; Strings and characters have distinct types. + (true-or-false? t (typep #\a 'character)) + (true-or-false? nil (typep "A" 'character)) + (true-or-false? nil (typep #\a 'string)) + ;; One can use both AREF and CHAR to refer to characters in a string. + (let ((my-string "Cookie Monster")) + (assert-equal #\C (char my-string 0)) + (assert-equal #\k (char my-string 3)) + (assert-equal #\M (aref my-string 7)))) + +(define-test concatenating-strings + ;; Concatenating strings in Common Lisp is possible, if a little cumbersome. + (let ((a "Lorem") + (b "ipsum") + (c "dolor")) + (assert-equal "Lorem ipsum dolor" (concatenate 'string a " " b " " c)))) + +(define-test searching-for-characters + ;; The function POSITION can be used to find the first position of an element + ;; in a sequence. If the element is not found, NIL is returned. + (assert-equal 1 (position #\b "abc")) + (assert-equal 2 (position #\c "abc")) + (assert-equal nil (position #\d "abc"))) + +(define-test finding-substrings + ;; The function SEARCH can be used to search a sequence for subsequences. + (let ((title "A supposedly fun thing I'll never do again")) + (assert-equal 2 (search "supposedly" title)) + (assert-equal 12 (search " fun" title)))) + diff --git a/koans-solved/structures.lisp b/koans-solved/structures.lisp new file mode 100644 index 00000000..362eddb9 --- /dev/null +++ b/koans-solved/structures.lisp @@ -0,0 +1,111 @@ +;;; 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. + +;;; Lisp structures encapsulate data which belongs together. They are a template +;;; of sorts, providing a way to generate multiple instances of uniformly +;;; organized information +;;; Defining a structure also interns accessor functions to get and set the +;;; slots of that structure. + +;;; The following form creates a new structure class named BASKETBALL-PLAYER +;;; with slots named NAME, TEAM, and NUMBER. +;;; This additionally creates functions MAKE-BASKETBALL-PLAYER, +;;; COPY-BASKETBALL-PLAYER, BASKETBALL-PLAYER-P, BASKETBALL-PLAYER-NAME, +;;; BASKETBALL-PLAYER-TEAM, and BASKETBALL-PLAYER-NUMBER. + +(defstruct basketball-player + name team number) + +(define-test make-struct + (let ((player (make-basketball-player :name "Larry" :team :celtics + :number 33))) + (true-or-false? t (basketball-player-p player)) + (assert-equal "Larry" (basketball-player-name player)) + (assert-equal :celtics (basketball-player-team player)) + (assert-equal 33 (basketball-player-number player)) + (setf (basketball-player-team player) :retired) + (assert-equal :retired (basketball-player-team player)))) + +;;; Structure fields can have default values. + +(defstruct baseball-player + name (team :red-sox) (position :outfield)) + +(define-test struct-defaults + (let ((player (make-baseball-player))) + ;; We have not specified a default value for NAME, therefore we cannot + ;; read it here - it would invoke undefined behaviour. + (assert-equal :red-sox (baseball-player-team player)) + (assert-equal :outfield (baseball-player-position player)))) + +;;; The accessor names can get pretty long. It's possible to specify a different +;;; prefix with the :CONC-NAME option. + +(defstruct (american-football-player (:conc-name nfl-guy-)) + name position team) + +(define-test struct-access + (let ((player (make-american-football-player + :name "Drew Brees" :position :qb :team "Saints"))) + (assert-equal "Drew Brees" (nfl-guy-name player)) + (assert-equal "Saints" (nfl-guy-team player)) + (assert-equal :qb (nfl-guy-position player)))) + +;;; Structs can be defined to include other structure definitions. +;;; This form of inheritance allows composition of objects. + +(defstruct (nba-contract (:include basketball-player)) + salary start-year end-year) + +(define-test structure-inheritance + (let ((contract (make-nba-contract :salary 136000000 + :start-year 2004 :end-year 2011 + :name "Kobe Bryant" + :team :lakers :number 24))) + (assert-equal 2004 (nba-contract-start-year contract)) + (assert-equal 'nba-contract (type-of contract)) + ;; Inherited structures follow the rules of type hierarchy. + (true-or-false? t (typep contract 'basketball-player)) + ;; One can access structure fields both with the structure's own accessors + ;; and with the inherited accessors. + (assert-equal :lakers (nba-contract-team contract)) + (assert-equal :lakers (basketball-player-team contract)))) + +;;; Copying a structure named FOO is handled with the COPY-FOO function. +;;; All such copies are shallow. + +(define-test structure-equality-and-copying + (let ((manning-1 (make-american-football-player + :name "Manning" :team (list "Colts" "Broncos"))) + (manning-2 (make-american-football-player + :name "Manning" :team (list "Colts" "Broncos")))) + ;; MANNING-1 and MANNING-2 are different objects... + (true-or-false? nil (eq manning-1 manning-2)) + ;;...but they contain the same information. + (true-or-false? t (equalp manning-1 manning-2)) + (let ((manning-3 (copy-american-football-player manning-1))) + (true-or-false? nil (eq manning-1 manning-3)) + (true-or-false? t (equalp manning-1 manning-3)) + ;; Setting the slot of one instance does not modify the others... + (setf (nfl-guy-name manning-1) "Rogers") + (true-or-false? nil (string= (nfl-guy-name manning-1) + (nfl-guy-name manning-3))) + (assert-equal "Rogers" (nfl-guy-name manning-1)) + (assert-equal "Manning" (nfl-guy-name manning-3)) + ;; ...but modifying shared structure may affect other instances. + (setf (car (nfl-guy-team manning-1)) "Giants") + (true-or-false? t (string= (car (nfl-guy-team manning-1)) + (car (nfl-guy-team manning-3)))) + (assert-equal "Giants" (car (nfl-guy-team manning-1))) + (assert-equal "Giants" (car (nfl-guy-team manning-3)))))) diff --git a/koans-solved/threads.lisp b/koans-solved/threads.lisp new file mode 100644 index 00000000..318e39f1 --- /dev/null +++ b/koans-solved/threads.lisp @@ -0,0 +1,161 @@ +;;; 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. + +;;; This lesson group uses Quicklisp to load Bordeaux Threads, a portability +;;; library for working with threads. This is because threads are not a part of +;;; the Common Lisp standard and implementations do them differently. +;;; If you are using Quicklisp, please feel free to enable this lesson by +;;; following the instructions in the README. + +;;; TODO: wait for Bordeaux Threads to implement a portable SEMAPHORE-COUNT +;;; and use it in the semaphore koans. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-test thread-return-value + ;; When a thread object is constructed, it accepts a function to execute. + (let* ((thread (bt:make-thread (lambda () (+ 2 2)))) + ;; When the thread's function finishes, its return value becomes the + ;; return value of BT:JOIN-THREAD. + (value (bt:join-thread thread))) + (assert-equal ____ value))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar *variable*) + +(define-test thread-global-bindings + ;; The global value of a variable is shared between all threads. + (setf *variable* 42) + (let ((thread (bt:make-thread (lambda () + (when (= *variable* 42) + (setf *variable* 24) + t))))) + (assert-true (bt:join-thread thread)) + (assert-equal ____ *variable*))) + +(define-test thread-local-bindings + ;; Newly established local bindings of a variable are visible only in the + ;; thread that established these bindings. + (setf *variable* 42) + (let ((thread (bt:make-thread (lambda () + (let ((*variable* 42)) + (setf *variable* 24)))))) + (bt:join-thread thread) + (assert-equal ____ *variable*))) + +(define-test thread-initial-bindings + ;; Initial dynamic bindings may be passed to the new thread. + (setf *variable* 42) + (let ((thread (bt:make-thread (lambda () (setf *variable* 24)) + :initial-bindings '((*variable* . 42))))) + (bt:join-thread thread) + (assert-equal ____ *variable*))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-test thread-name + ;; Threads can have names. + (let ((thread (bt:make-thread #'+ :name "Summing thread"))) + (assert-equal ____ (bt:thread-name thread)) + (assert-equal ____ (bt:join-thread thread)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-test thread-function-arguments + ;; Passing arguments to thread functions requires closing over them. + (let* ((x 240) + (y 18) + (thread (bt:make-thread (lambda () (* x y))))) + (assert-equal ____ (bt:join-thread thread)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-test destroy-thread + ;; Looping and renegade threads can usually be killed via BT:DESTROY-THREAD. + ;; It is the last measure, since doing so might leave the Lisp system in an + ;; unpredictable state if the thread was doing something complex. + (let ((thread (bt:make-thread (lambda () (loop (sleep 1)))))) + (true-or-false? ____ (bt:thread-alive-p thread)) + (bt:destroy-thread thread) + (true-or-false? ____ (bt:thread-alive-p thread)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar *another-variable*) + +;; Preventing concurrent access to some data can be achieved via a lock in +;; order to avoid race conditions. + +(defvar *lock* (bt:make-lock)) + +(define-test lock + (setf *another-variable* 0) + (flet ((increaser () (bt:with-lock-held (*lock*) (incf *another-variable*)))) + (loop repeat 100 + collect (bt:make-thread #'increaser) into threads + finally (loop until (notany #'bt:thread-alive-p threads)) + (assert-equal ____ *another-variable*)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; We can further orchestrate threads by using semaphores. + +(defvar *semaphore* (bt:make-semaphore)) + +(defun signal-our-semaphore () + (bt:signal-semaphore semaphore)) + +(defun wait-on-our-semaphore () + (bt:wait-on-semaphore semaphore :timeout 100)) + +(define-test semaphore + (assert-equal 1 (bt:join-thread (bt:make-thread #'signal-our-semaphore))) + (assert-equal ____ (bt:join-thread (bt:make-thread #'signal-our-semaphore))) + (assert-equal ____ (bt:join-thread (bt:make-thread #'signal-our-semaphore))) + (assert-equal 2 (bt:join-thread (bt:make-thread #'wait-on-our-semaphore))) + (assert-equal ____ (bt:join-thread (bt:make-thread #'wait-on-our-semaphore))) + (assert-equal ____ (bt:join-thread (bt:make-thread #'wait-on-our-semaphore))) + (assert-equal ____ (bt:join-thread (bt:make-thread #'wait-on-our-semaphore)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Semaphores can be used to manage resource allocation and to trigger some +;; threads to run when the semaphore value is above zero. + +(defvar *foobar-semaphore* (bt:make-semaphore)) + +(defvar *foobar-list*) + +(defun bar-pusher () + (dotimes (i 10) + (sleep 0.01) + (push i (nth i *foobar-list*)) + (push :bar (nth i *foobar-list*)) + ;; We push :BAR before :FOO, so the final list looks like (:FOO :BAR). + (bt:signal-semaphore *foobar-semaphore*))) + +(defun foo-pusher () + (dotimes (i 10) + (bt:wait-on-semaphore *foobar-semaphore*) + (push :foo (nth i *foobar-list*)))) + +(define-test list-of-foobars + (setf *foobar-list* (make-list 10)) + (let ((bar-pusher (bt:make-thread #'bar-pusher)) + (foo-pusher (bt:make-thread #'foo-pusher))) + (bt:join-thread foo-pusher)) + (assert-equal ____ (nth 0 *foobar-list*)) + (assert-equal ____ (nth 1 *foobar-list*)) + (assert-equal ____ (nth 5 *foobar-list*))) diff --git a/koans-solved/triangle-project.lisp b/koans-solved/triangle-project.lisp new file mode 100644 index 00000000..2eec4805 --- /dev/null +++ b/koans-solved/triangle-project.lisp @@ -0,0 +1,64 @@ +;;; 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. + +(define-condition triangle-error (error) + ;; Fill in the blank with a suitable slot definition. + (____)) + +(defun triangle (a b c) + ;;;Fill in the blank with a function that satisfies the below tests. + ____) + +(define-test equilateral-triangles + ;; Equilateral triangles have three sides of equal length, + (assert-equal :equilateral (triangle 2 2 2)) + (assert-equal :equilateral (triangle 10 10 10))) + +(define-test isosceles-triangles + ;; Isosceles triangles have two sides of equal length, + (assert-equal :isosceles (triangle 3 4 4)) + (assert-equal :isosceles (triangle 4 3 4)) + (assert-equal :isosceles (triangle 4 4 3)) + (assert-equal :isosceles (triangle 10 10 2))) + +(define-test scalene-triangles + ;; Scalene triangles have three sides of different lengths. + (assert-equal :scalene (triangle 3 4 5)) + (assert-equal :scalene (triangle 10 11 12)) + (assert-equal :scalene (triangle 5 4 2))) + +(define-test illegal-triangles + ;; Not all triplets make valid triangles. + (flet ((triangle-failure (a b c) + (handler-case (progn (triangle a b c) (error "Test failure")) + (error (condition) condition)))) + (let ((condition (triangle-failure 0 0 0))) + (assert-true (typep condition 'type-error)) + (assert-equal 0 (type-error-datum)) + ;; The type (REAL (0)) represents all positive numbers. + (assert-true (subtypep (type-error-expected-type condition) '(real (0)))) + ;; If two type specifiers are SUBTYPEP of one another, then they represent + ;; the same Lisp type. + (assert-true (subtypep '(real (0)) (type-error-expected-type condition)))) + (let ((condition (triangle-failure 3 4 -5))) + (assert-true (typep condition 'type-error)) + (assert-equal -5 (type-error-datum)) + (assert-true (subtypep (type-error-expected-type condition) '(real (0)))) + (assert-true (subtypep '(real (0)) (type-error-expected-type condition)))) + (let ((condition (triangle-failure 1 1 3))) + (assert-true (typep condition 'triangle-error)) + (assert-equal '(1 1 3) (triangle-error-sides condition))) + (let ((condition (triangle-failure 2 4 2))) + (assert-true (typep condition 'triangle-error)) + (assert-equal '(2 4 2) (triangle-error-sides condition))))) diff --git a/koans-solved/type-checking.lisp b/koans-solved/type-checking.lisp new file mode 100644 index 00000000..62c6c11a --- /dev/null +++ b/koans-solved/type-checking.lisp @@ -0,0 +1,152 @@ +;;; 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. + +;;; There is a type hierarchy in Lisp, based on the set theory. +;;; An object may belong to multiple types at the same time. +;;; Every object is of type T. No object is of type NIL. + +(define-test typep + ;; TYPEP returns true if the provided object is of the provided type. + (true-or-false? ____ (typep "hello" 'string)) + (true-or-false? ____ (typep "hello" 'array)) + (true-or-false? ____ (typep "hello" 'list)) + (true-or-false? ____ (typep "hello" '(simple-array character (5)))) + (true-or-false? ____ (typep '(1 2 3) 'list)) + (true-or-false? ____ (typep 99 'integer)) + (true-or-false? ____ (typep nil 'NULL)) + (true-or-false? ____ (typep 22/7 'ratio)) + (true-or-false? ____ (typep 4.0 'float)) + (true-or-false? ____ (typep #\a 'character)) + (true-or-false? ____ (typep #'length 'function))) + +(define-test type-of + ;; TYPE-OF returns a type specifier for the object. + (assert-equal ____ (type-of '())) + (assert-equal ____ (type-of 4/6))) + +(define-test overlapping-types + ;; Because Lisp types are mathematical sets, they are allowed to overlap. + (let ((thing '())) + (true-or-false? ____ (typep thing 'list)) + (true-or-false? ____ (typep thing 'atom)) + (true-or-false? ____ (typep thing 'null)) + (true-or-false? ____ (typep thing 't)))) + +(define-test fixnum-versus-bignum + ;; In Lisp, integers are either fixnums or bignums. Fixnums are handled more + ;; efficiently by the implementation, but some large integers can only be + ;; represented as bignums. + ;; Lisp converts between these two types on the fly. The constants + ;; MOST-NEGATIVE-FIXNUM and MOST-POSITIVE-FIXNUM describe the limits for + ;; fixnums. + (let ((integer-1 0) + (integer-2 most-positive-fixnum) + (integer-3 (1+ most-positive-fixnum)) + (integer-4 (1- most-negative-fixnum))) + (true-or-false? ____ (typep integer-1 'fixunm)) + (true-or-false? ____ (typep integer-1 'bignum)) + (true-or-false? ____ (typep integer-2 'fixnum)) + (true-or-false? ____ (typep integer-2 'bignum)) + (true-or-false? ____ (typep integer-3 'fixnum)) + (true-or-false? ____ (typep integer-3 'bignum)) + (true-or-false? ____ (typep integer-4 'fixnum)) + (true-or-false? ____ (typep integer-4 'bignum)) + ;; Regardless of whether an integer is a fixnum or a bignum, it is still + ;; an integer. + (true-or-false? ____ (typep integer-1 'integer)) + (true-or-false? ____ (typep integer-2 'integer)) + (true-or-false? ____ (typep integer-3 'integer)) + (true-or-false? ____ (typep integer-4 'integer)))) + +(define-test subtypep + (assert-true (typep 1 'bit)) + (assert-true (typep 1 'fixnum)) + (assert-true (typep 1 'integer)) + (assert-true (typep 2 'integer)) + ;; The function SUBTYPEP attempts to answer whether one type specifier + ;; represents a subtype of the other type specifier. + (true-or-false? ____ (subtypep 'bit 'integer)) + (true-or-false? ____ (subtypep (type-of 1) (type-of 2))) + (true-or-false? ____ (subtypep (type-of 2) (type-of 1)))) + +(define-test list-type-specifiers + ;; Some type specifiers are lists; this way, they carry more information than + ;; type specifiers which are symbols. + (assert-true (typep (make-array 0) '(vector * 0))) + (assert-true (typep (make-array 42) '(vector * 42))) + (assert-true (typep (make-array 42 :element-type 'bit) '(vector bit 42))) + (assert-true (typep (make-array '(4 2)) '(array * (4 2)))) + (true-or-false? ____ (typep (make-array '(3 3)) '(simple-array t (3 3)))) + (true-or-false? ____ (typep (make-array '(3 2 1)) '(simple-array t (1 2 3))))) + +(define-test list-type-specifiers-hierarchy + ;; Type specifiers that are lists also follow hierarchy. + (true-or-false? ____ (subtypep '(simple-array t (3 3)) '(simple-array t *))) + (true-or-false? ____ (subtypep '(vector double-float 100) '(vector * 100))) + (true-or-false? ____ (subtypep '(vector double-float 100) '(vector double-float *))) + (true-or-false? ____ (subtypep '(vector double-float 100) '(vector * *))) + (true-or-false? ____ (subtypep '(vector double-float 100) '(array number *))) + (true-or-false? ____ (subtypep '(vector double-float 100) t))) + +(define-test type-coercion + (assert-true (typep 0 'integer)) + (true-or-false? ____ (typep 0 'short-float)) + (true-or-false? ____ (subtypep 'integer 'short-float)) + (true-or-false? ____ (subtypep 'short-float 'integer)) + ;; The function COERCE makes it possible to convert values between some + ;; standard types. + (true-or-false? ____ (typep (coerce 0 'short-float) 'short-float))) + +(define-test atoms-are-anything-thats-not-a-cons + ;; In Lisp, an atom is anything that is not a cons cell. The function ATOM + ;; returns true if its object is an atom. + (true-or-false? ____ (atom 4)) + (true-or-false? ____ (atom '(1 2 3 4))) + (true-or-false? ____ (atom '(:foo . :bar))) + (true-or-false? ____ (atom 'symbol)) + (true-or-false? ____ (atom :keyword)) + (true-or-false? ____ (atom #(1 2 3 4 5))) + (true-or-false? ____ (atom #\A)) + (true-or-false? ____ (atom "string")) + (true-or-false? ____ (atom (make-array '(4 4))))) + +(define-test functionp + ;; The function FUNCTIONP returns true if its arguments is a function. + (assert-true (functionp (lambda (a b c) (+ a b c)))) + (true-or-false? ____ (functionp #'make-array)) + (true-or-false? ____ (functionp 'make-array)) + (true-or-false? ____ (functionp (lambda (x) (* x x)))) + (true-or-false? ____ (functionp '(lambda (x) (* x x)))) + (true-or-false? ____ (functionp '(1 2 3))) + (true-or-false? ____ (functionp t))) + +(define-test other-type-predicates + ;; Lisp defines multiple type predicates for standard types.. + (true-or-false? ____ (numberp 999)) + (true-or-false? ____ (listp '(9 9 9))) + (true-or-false? ____ (integerp 999)) + (true-or-false? ____ (rationalp 9/99)) + (true-or-false? ____ (floatp 9.99)) + (true-or-false? ____ (stringp "nine nine nine")) + (true-or-false? ____ (characterp #\9)) + (true-or-false? ____ (bit-vector-p #*01001))) + +(define-test guess-that-type + ;; Fill in the blank with a type specifier that satisfies the following tests. + (let ((type ____)) + (assert-true (subtypep type '(simple-array t (* 3 *)))) + (assert-true (subtypep type '(simple-array t (5 * *)))) + (assert-true (subtypep type '(simple-array array *))) + (assert-true (typep (make-array '(5 3 9) :element-type 'string) type)) + (assert-true (typep (make-array '(5 3 33) :element-type 'vector) type)))) diff --git a/koans-solved/variables-parameters-constants.lisp b/koans-solved/variables-parameters-constants.lisp new file mode 100644 index 00000000..ca960376 --- /dev/null +++ b/koans-solved/variables-parameters-constants.lisp @@ -0,0 +1,88 @@ +;; 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. + +(defun test-variable-assignment-with-setf () + ;; the let pattern allows us to create local variables with + ;; lexical scope. + (let (var_name_1 (var_name_2 "Michael")) + ;; variables may be defined with or without initial values. + (and + (equalp var_name_2 "Michael") + ; new values may be assigned to variables with setf + (setf var_name_2 "Janet") + (equalp var_name_2 "Janet") + ; setf may assign multiple variables in one form. + (setf var_name_1 "Tito" + var_name_2 "Jermaine") + (equalp var_name_1 "Tito") + (equalp var_name_2 "Jermaine")))) + +(defun test-setf-for-lists () + ;; setf also works on list elements + (let (l) + (setf l '(1 2 3)) + (equalp l '(1 2 3)) + ; First second and third are convenient accessor functions + ; referring to the elements of a list + ; For those interested, they are convenient to car, cadr, and caddr + (setf (first l) 10) + (setf (second l) 20) + (setf (third l) 30) + (equalp l '(10 20 30)))) + +(defparameter param_name_1 "Janet") +; defparameter requires an initial form. It is a compiler error to exclude it +;(defparameter param_no_init) ;; this will fail +(defconstant additive_identity 0) +; defconstant also requires an initial form +; (defconstant constant_no_init) + +; reassigning parameters to new values is also ok, but parameters carry the +; connotation of immutability. If it's going to change frequently, it should +; be a var. +(setf param_name_1 "The other one") + +; reassigning a constant is an error. +; this should result in a compile time error +; (setf additive_identity -1) + + +;; ------------------------------- +;; below is necessary to run tests. +;; ------------------------------- + +(defvar failed-test-names nil) + +(defun run-test (testfun) + (let ((fun-name (function-name testfun))) + (if (apply testfun '()) + (format t ".") + (progn + (setf failed-test-names (cons fun-name failed-test-names)) + (format t "F"))))) + +(defun function-name (function) (nth-value 2 (function-lambda-expression function))) + + +(run-test #'test-variable-assignment-with-setf) +(run-test #'test-setf-for-lists) + +(format t "~%") + +(defun report-failure (test-name) + (format t "~S failed.~%" test-name)) + +(if (endp failed-test-names) ; no failed tests + (format t "all tests pass.~%") + (mapcar #'report-failure failed-test-names)) \ No newline at end of file diff --git a/koans-solved/vectors.lisp b/koans-solved/vectors.lisp new file mode 100644 index 00000000..32b4eec4 --- /dev/null +++ b/koans-solved/vectors.lisp @@ -0,0 +1,54 @@ +;;; 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. + +;;; Vectors are one-dimensional arrays. This means that general array operations +;;; will work on vectors normally. However, Lisp also defines some functions for +;;; operating on sequences - which means, either vectors or lists. + +(define-test vector-basics + ;; #(...) is syntax sugar for defining literal vectors. + (let ((vector #(1 11 111))) + (true-or-false? t (typep vector 'vector)) + (assert-equal 11 (aref vector 1)))) + +(define-test length + ;; The function LENGTH works both for vectors and for lists. + (assert-equal 3 (length '(1 2 3))) + (assert-equal 3 (length #(1 2 3)))) + +(define-test bit-vector + ;; #*0011 defines a bit vector literal with four elements: 0, 0, 1 and 1. + (assert-equal #*0011 (make-array 4 :element-type 'bit + :initial-contents '(0 0 1 1))) + (true-or-false? t (typep #*1001 'bit-vector)) + (assert-equal 0 (aref #*1001 1))) + +(define-test bitwise-operations + ;; Lisp defines a few bitwise operations that work on bit vectors. + (assert-equal #*1000 (bit-and #*1100 #*1010)) + (assert-equal #*1110 (bit-ior #*1100 #*1010)) + (assert-equal #*0110 (bit-xor #*1100 #*1010))) + +(defun list-to-bit-vector (list) + ;; Implement a function that turns a list into a bit vector. + (coerce list 'bit-vector)) + +(define-test list-to-bit-vector + ;; You need to fill in the blank in LIST-TO-BIT-VECTOR. + (assert-true (typep (list-to-bit-vector '(0 0 1 1 0)) 'bit-vector)) + (assert-equal (aref (list-to-bit-vector '(0)) 0) 0) + (assert-equal (aref (list-to-bit-vector '(0 1)) 1) 1) + (assert-equal (length (list-to-bit-vector '(0 0 1 1 0 0 1 1))) 8)) + + diff --git a/koans/arrays.lisp b/koans/arrays.lisp index bbb9d67f..788abeee 100644 --- a/koans/arrays.lisp +++ b/koans/arrays.lisp @@ -37,7 +37,7 @@ ;; You may need to modify your array after you create it. (setf (____ color-cube ____ ____ ____) ____ (____ color-cube ____ ____ ____) ____) - (if (typep color-cube '(simple-array T (3 3 3))) + (if (typep color-cube '(simple-array t (3 3 3))) (progn (assert-equal 3 (array-rank color-cube)) (assert-equal '(3 3 3) (array-dimensions color-cube)) diff --git a/koans/basic-macros.lisp b/koans/basic-macros.lisp index 28412c7f..d5b14c9e 100644 --- a/koans/basic-macros.lisp +++ b/koans/basic-macros.lisp @@ -62,9 +62,9 @@ (define-test special-cases-of-case ;; You need to fill in the blanks in MATCH-SPECIAL-CASES. - (assert-equal :found-a-t (case-special-symbols-match t)) - (assert-equal :found-a-nil (case-special-symbols-match nil)) - (assert-equal :something-else (case-special-symbols-match 42))) + (assert-equal :found-a-t (match-special-cases t)) + (assert-equal :found-a-nil (match-special-cases nil)) + (assert-equal :something-else (match-special-cases 42))) (define-test your-own-case-statement ;; We use FLET to define a local function. @@ -87,22 +87,18 @@ ;; from EQUAL. ;; EQL is suitable for comparing numbers, characters, and objects for whom we ;; want to check verify they are the same object. - (let ((string "A string") - (string-copy (copy-seq string))) + (let* ((string "A string") + (string-copy (copy-seq string))) ;; The above means that two distinct strings will not be the same under EQL, ;; even if they have the same contents. (true-or-false? ____ (eql string string-copy)) (true-or-false? ____ (equal string string-copy)) ;; The above also means that CASE might give surprising results when used on ;; strings. - (let ((match-1 (case string - (string-copy :matched) - (t :not-matched))) - (match-2 (case string - (string :matched) - (t :not-matched)))) - (assert-equal ____ match-1) - (assert-equal ____ match-2)) + (let ((match (case string + ("A string" :matched) + (t :not-matched)))) + (assert-equal ____ match)) ;; We will explore this topic further in the EQUALITY-DISTINCTIONS lesson. )) diff --git a/koans/evaluation.lisp b/koans/evaluation.lisp index 176b3187..ef0e7a5a 100644 --- a/koans/evaluation.lisp +++ b/koans/evaluation.lisp @@ -34,7 +34,7 @@ ;; Arguments to a function are evaluated before the function is called. (assert-equal ____ (* (+ 1 2) (- 13 10)))) -(define-test basic-arithmetic +(define-test basic-comparisons ;; The below functions are boolean functions (predicates) that operate on ;; numbers. (assert-equal ____ (> 25 4)) diff --git a/koans/functions.lisp b/koans/functions.lisp index c691362d..ae8b6a93 100644 --- a/koans/functions.lisp +++ b/koans/functions.lisp @@ -27,7 +27,7 @@ (if (or (= 0 a) (= 0 b)) 1 (+ (* a b) (recursive-function (1- a) (1- b)))))) - (assert-equal ____ (different-named-function 4 5)))) + (assert-equal ____ (recursive-function 4 5)))) (define-test shadow-a-function (assert-eq 18 (some-named-function 7 11)) @@ -75,11 +75,11 @@ (assert-equal ____ (function-with-keyword-parameters)) (assert-equal ____ (function-with-keyword-parameters :a 11 :b 22 :c 33)) ;; It is not necessary to specify all keyword parameters. - (assert-equal ____ (func-with-key-params :b 22)) + (assert-equal ____ (function-with-keyword-parameters :b 22)) ;; Keyword argument order is not important. - (assert-equal ____ (func-with-key-params :b 22 :c -5/2 :a 0)) + (assert-equal ____ (function-with-keyword-parameters :b 22 :c -5/2 :a 0)) ;; Lisp handles duplicate keyword parameters. - (assert-equal ____ (func-with-key-params :b 22 :b 40 :b 812))) + (assert-equal ____ (function-with-keyword-parameters :b 22 :b 40 :b 812))) (defun function-with-keyword-indication (&key (a 2 a-provided-p) (b 3 b-provided-p)) @@ -99,10 +99,10 @@ (list a b c c-provided-p x)) (define-test funky-parameters - (assert-equal (func-with-funky-parameters 1) ___) - (assert-equal (func-with-funky-parameters 1 :b 2) ___) - (assert-equal (func-with-funky-parameters 1 :b 2 :c 3) ___) - (assert-equal (func-with-funky-parameters 1 :c 3 :b 2) ___)) + (assert-equal ____ (function-with-funky-parameters 1)) + (assert-equal ____ (function-with-funky-parameters 1 :b 2)) + (assert-equal ____ (function-with-funky-parameters 1 :b 2 :c 3)) + (assert-equal ____ (function-with-funky-parameters 1 :c 3 :b 2))) (define-test lambda ;; A list form starting with the symbol LAMBDA denotes an anonymous function. @@ -148,14 +148,14 @@ ;; listed in its first argument to the parts of the list returned by the form ;; that is its second argument. (destructuring-bind (reader-1 writer-1) (make-reader-and-writer 1) - (destructuring-bind (reader-2 writer-2) (make-reader-and-writer :one)) - (assert-equal ____ (funcall reader-1)) - (funcall writer-1 0) - (assert-equal ____ (funcall reader-1)) - ;; The two different function pairs refer to different places. - (assert-equal ____ (funcall reader-2)) - (funcall writer-2 :zero) - (assert-equal ____ (funcall reader-2)))) + (destructuring-bind (reader-2 writer-2) (make-reader-and-writer :one) + (assert-equal ____ (funcall reader-1)) + (funcall writer-1 0) + (assert-equal ____ (funcall reader-1)) + ;; The two different function pairs refer to different places. + (assert-equal ____ (funcall reader-2)) + (funcall writer-2 :zero) + (assert-equal ____ (funcall reader-2))))) (define-test apply ;; The function APPLY applies a function to a list of arguments. diff --git a/koans/hash-tables.lisp b/koans/hash-tables.lisp index 2396f467..d5a7b89d 100644 --- a/koans/hash-tables.lisp +++ b/koans/hash-tables.lisp @@ -53,14 +53,14 @@ (equal-table (make-hash-table :test #'equal)) (equalp-table (make-hash-table :test #'equalp))) ;; We will define four variables whose values are strings. - (let ((string "one") - (same-string string) - (string-copy (copy-string string)) - (string-upcased "ONE"))) - ;; We will insert the value of each variable into each hash table. - (dolist (thing (list string same-string string-copy string-upcased)) - (dolist (hash-table (list eq-table eql-table equal-table equalp-table)) - (setf (gethash string hash-table) t))) + (let* ((string "one") + (same-string string) + (string-copy (copy-seq string)) + (string-upcased "ONE")) + ;; We will insert the value of each variable into each hash table. + (dolist (thing (list string same-string string-copy string-upcased)) + (dolist (hash-table (list eq-table eql-table equal-table equalp-table)) + (setf (gethash thing hash-table) t)))) ;; How many entries does each hash table contain? (assert-equal ____ (hash-table-count eq-table)) (assert-equal ____ (hash-table-count eql-table)) diff --git a/koans/lists.lisp b/koans/lists.lisp index ac3d9a52..4ed0946a 100644 --- a/koans/lists.lisp +++ b/koans/lists.lisp @@ -23,7 +23,7 @@ ;; Freshly constructed lists can be passed using the LIST function. (some-evens (list (* 2 1) (* 2 2) (* 2 3))) ;; Lists can also be passed using quotes and dot notation... - (long-numbers '(16487302 . (3826700034 . (10000000 . '())))) + (long-numbers '(16487302 . (3826700034 . (10000000 . nil)))) ;; ...or by using the function CONS. (names (cons "Matthew" (cons "Mark" (cons "Margaret" '()))))) ;; Try filling in the below blanks in different ways. @@ -56,13 +56,13 @@ ;; Calls to CAR and CDR are often intertwined to extract data from a nested ;; cons structure. (let ((structure '((1 2) (("foo" . "bar"))))) - (assert-equal ____ (car x)) - (assert-equal ____ (car (cdr x))) - (assert-equal ____ (cdr (car (car (cdr x))))) + (assert-equal ____ (car structure)) + (assert-equal ____ (car (cdr structure))) + (assert-equal ____ (cdr (car (car (cdr structure))))) ;; Lisp defines shorthand functions for up to four such nested calls. - (assert-equal ____ (car x)) - (assert-equal ____ (cadr x)) - (assert-equal ____ (cdaadr x)))) + (assert-equal ____ (car structure)) + (assert-equal ____ (cadr structure)) + (assert-equal ____ (cdaadr structure)))) (define-test push-pop ;; PUSH and POP are macros similar to SETF, as both of them operate on places. @@ -123,7 +123,7 @@ ;; ...or pass them as literals via dot notation. (y '(6 7 8 9 . 0))) (assert-equal ____ (last x)) - (assert-equal ____ (list y))) + (assert-equal ____ (last y))) ;; We can create a cyclic list by changing the last CDR of a list to refer to ;; another cons cell (let ((list (list 1 2 3 4 5)) diff --git a/koans/scope-and-extent.lisp b/koans/scope-and-extent.lisp index ac55459f..7b5ae1b0 100644 --- a/koans/scope-and-extent.lisp +++ b/koans/scope-and-extent.lisp @@ -28,8 +28,8 @@ (return-from outer 'valve))) (define-test block-return-from - (assert-equal ____ (block-01)) - (assert-equal ____ (block-02))) + (assert-equal ____ (block-1)) + (assert-equal ____ (block-2))) ;;; See http://www.gigamonkeys.com/book/variables.html diff --git a/koans/structures.lisp b/koans/structures.lisp index e6c89c38..42f88efd 100644 --- a/koans/structures.lisp +++ b/koans/structures.lisp @@ -28,7 +28,8 @@ name team number) (define-test make-struct - (let ((player (make-basketball-player :name "Larry" :team :celtics :number 33))) + (let ((player (make-basketball-player :name "Larry" :team :celtics + :number 33))) (true-or-false? ____ (basketball-player-p player)) (assert-equal ____ (basketball-player-name player)) (assert-equal ____ (basketball-player-team player)) @@ -96,9 +97,15 @@ (let ((manning-3 (copy-american-football-player manning-1))) (true-or-false? ____ (eq manning-1 manning-3)) (true-or-false? ____ (equalp manning-1 manning-3)) - ;; Setting the slot of one instance does not modify the others. + ;; Setting the slot of one instance does not modify the others... + (setf (nfl-guy-name manning-1) "Rogers") + (true-or-false? ____ (string= (nfl-guy-name manning-1) + (nfl-guy-name manning-3))) + (assert-equal ____ (nfl-guy-name manning-1)) + (assert-equal ____ (nfl-guy-name manning-3)) + ;; ...but modifying shared structure may affect other instances. (setf (car (nfl-guy-team manning-1)) "Giants") (true-or-false? ____ (string= (car (nfl-guy-team manning-1)) (car (nfl-guy-team manning-3)))) (assert-equal ____ (car (nfl-guy-team manning-1))) - (assert-equal ____ (car (nfl-guy-team manning-1)))))) + (assert-equal ____ (car (nfl-guy-team manning-3)))))) diff --git a/lisp-koans.lisp b/lisp-koans.lisp index 895113e3..ce8300d4 100644 --- a/lisp-koans.lisp +++ b/lisp-koans.lisp @@ -30,7 +30,7 @@ (defun package-name-from-group-name (group-name) (format nil "COM.GOOGLE.LISP-KOANS.KOANS.~A" group-name)) -(defun load-koan-group-named (koan-group-name) +(defun load-koan-group-named (dirname koan-group-name) (let* ((koan-name (string-downcase (string koan-group-name))) (koan-file-name (concatenate 'string koan-name ".lisp")) (koan-package-name (package-name-from-group-name koan-group-name))) @@ -38,11 +38,11 @@ (make-package koan-package-name :use '(#:common-lisp #:com.google.lisp-koans.test))) (let ((*package* (find-package koan-package-name))) - (load (concatenate 'string "koans/" koan-file-name))))) + (load (concatenate 'string dirname "/" koan-file-name))))) -(defun load-all-koans () +(defun load-all-koans (dirname) (loop for koan-group-name in *all-koan-groups* - do (load-koan-group-named koan-group-name))) + do (load-koan-group-named dirname koan-group-name))) ;;; Functions for executing koans @@ -62,8 +62,8 @@ (dolist (result (reverse results)) (destructuring-bind (test-name results) result (let ((format-control (if (every (lambda (x) (equalp :pass x)) results) - " ~A has expanded your awareness.~%~%" - " ~A requires more meditation.~%~%"))) + " ~A has expanded your awareness.~%" + " ~A requires more meditation.~%"))) (format t format-control test-name))))) ;;; Functions for processing results @@ -89,17 +89,17 @@ ((find :error koan-status) "A koan signaled an error.") (t (format nil "Last koan status: ~A." koan-status)))) -(defun print-next-suggestion-message () +(defun print-next-suggestion-message (dirname) (let ((filename (caar *collected-results*)) (koan-name (caaadr (car (last (last *collected-results*))))) (koan-status (reverse (cadaar (cdar (last (last *collected-results*))))))) - (format t "You have not yet reached enlightenment. + (format t "~&You have not yet reached enlightenment. ~A Please meditate on the following code: - File \"koans/~(~A~).lisp\" + File \"~A/~(~A~).lisp\" Koan \"~A\" Current koan assert status is \"~A\"~%~%" - (koan-status-message koan-status) filename koan-name koan-status))) + (koan-status-message koan-status) dirname filename koan-name koan-status))) (defun print-completion-message () (format t "********************************************************* @@ -118,15 +118,15 @@ Write and submit your own improvements to https://github.com/google/lisp-koans! (1- (length *collected-results*)) (length *all-koan-groups*))) -(defun output-advice () +(defun output-advice (dirname) (cond ((any-assert-non-pass-p) - (print-next-suggestion-message) + (print-next-suggestion-message dirname) (print-progress-message)) (t (print-completion-message)))) ;;; Main -(defun main () - (load-all-koans) +(defun main (&optional (dirname "koans")) + (load-all-koans dirname) (execute-koans) - (output-advice)) + (output-advice dirname)) diff --git a/test-framework.lisp b/test-framework.lisp index 0c1afcf2..718ce5ad 100644 --- a/test-framework.lisp +++ b/test-framework.lisp @@ -92,7 +92,7 @@ (defun test-passed-p (type expected actual test) (ecase type (:error (or (eql (car actual) (car expected)) (typep (car actual) (car expected)))) - (:equal (and (<= (length expected) (length actual)) (every test expected actual))) + (:equal (and (>= (length expected) (length actual)) (every test expected actual))) (:macro (equal (car actual) (car expected))) (:result (eql (not (car actual)) (not (car expected)))))) @@ -138,7 +138,7 @@ (defmacro true-or-false? (form expected) "Assert whether expected and form are logically equivalent." - `(expand-assert :equal ,form (notnot ,form) ,(notnot expected) :test #'eql)) + `(expand-assert :equal ,form (notnot ,form) (notnot ,expected) :test #'eql)) (defmacro assert-error (form condition) "Assert whether form signals condition." diff --git a/test.lisp b/test.lisp new file mode 100644 index 00000000..dbca2fb2 --- /dev/null +++ b/test.lisp @@ -0,0 +1,29 @@ +;;; 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. + +(in-package :cl-user) + +;;; Though Clozure / CCL runs lisp-koans on the command line using +;;; "ccl -l contemplate.lisp", the following lines are needed to +;;; meditate on the koans within the CCL IDE. +;;; (The :hemlock is used to distiguish between ccl commandline and the IDE) +#+(and :ccl :hemlock) +(setf *default-pathname-defaults* (directory-namestring *load-pathname*)) + +(load "test-framework.lisp") +(load "lisp-koans.lisp") + +#+quicklisp (ql:quickload :bordeaux-threads) + +(com.google.lisp-koans:main "koans-solved") From f3ed44bdbfb46e99cf8582f846b3986ca0b3839e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Sat, 9 May 2020 08:51:58 +0200 Subject: [PATCH 101/133] Various fixes --- koans-solved/control-statements.lisp | 32 ++++++------- koans-solved/iteration.lisp | 22 ++++----- koans-solved/loops.lisp | 70 ++++++++++++++-------------- koans-solved/mapcar-and-reduce.lisp | 67 ++++++++++++++------------ koans/control-statements.lisp | 12 ++--- koans/iteration.lisp | 10 ++-- koans/loops.lisp | 22 ++++----- koans/mapcar-and-reduce.lisp | 16 +++---- koans/scoring-project.lisp | 2 +- lisp-koans.lisp | 2 +- 10 files changed, 130 insertions(+), 125 deletions(-) diff --git a/koans-solved/control-statements.lisp b/koans-solved/control-statements.lisp index a5952854..796ca86b 100644 --- a/koans-solved/control-statements.lisp +++ b/koans-solved/control-statements.lisp @@ -14,18 +14,18 @@ (define-test if ;; IF only evaluates and returns one branch of a conditional expression. - (assert-equal ____ (if t :true :false)) - (assert-equal ____ (if nil :true :false)) + (assert-equal :true (if t :true :false)) + (assert-equal :false (if nil :true :false)) ;; This also applies to side effects that migh or might not be evaluated. (let ((result)) (if t (setf result :true) (setf result :false)) - (assert-equal ____ result) + (assert-equal :true result) (if nil (setf result :true) (setf result :false)) - (assert-equal ____ result))) + (assert-equal :false result))) (define-test when-unless ;; WHEN and UNLESS are like one-branched IF statements. @@ -40,29 +40,29 @@ (unless (> x 5) (setf unless-result x) (push x unless-numbers))) - (assert-equal ____ when-result) - (assert-equal ____ when-numbers) - (assert-equal ____ unless-result) - (assert-equal ____ unless-numbers))) + (assert-equal 10 when-result) + (assert-equal '(10 9 8 7 6) when-numbers) + (assert-equal 5 unless-result) + (assert-equal '(5 4 3 2 1) unless-numbers))) (define-test and-short-circuit ;; AND only evaluates forms until one evaluates to NIL. - (assert-equal ____ + (assert-equal 5 (let ((x 0)) (and - (setf x (+ 1 x)) - (setf x (+ 1 x)) + (setf x (+ 2 x)) + (setf x (+ 3 x)) nil - (setf x (+ 1 x))) + (setf x (+ 4 x))) x))) (define-test or-short-circuit ;; AND only evaluates forms until one evaluates to non-NIL. - (assert-equal ____ + (assert-equal 2 (let ((x 0)) (or - (setf x (+ 1 x)) - (setf x (+ 1 x)) + (setf x (+ 2 x)) + (setf x (+ 3 x)) nil - (setf x (+ 1 x))) + (setf x (+ 4 x))) x))) diff --git a/koans-solved/iteration.lisp b/koans-solved/iteration.lisp index e820bc51..65338f4c 100644 --- a/koans-solved/iteration.lisp +++ b/koans-solved/iteration.lisp @@ -22,11 +22,11 @@ (dolist (number numbers) ;; (INCF PLACE N) is equivalent to (SETF PLACE (+ N PLACE)). (incf sum number)) - (assert-equal ____ sum)) + (assert-equal 108 sum)) ;; DOLIST can optionally return a value. (let ((sum 0)) - (assert-equal ____ (dolist (number numbers sum) - (incf sum number)))))) + (assert-equal 108 (dolist (number numbers sum) + (incf sum number)))))) (define-test dotimes ;; The macro DOTIMES binds a variable to subsequent integers from 0 to @@ -34,11 +34,11 @@ (let ((stack '())) (dotimes (i 5) (push i stack)) - (assert-equal ____ stack)) + (assert-equal '(4 3 2 1 0) stack)) ;; DOTIMES can optionally return a value. (let ((stack '())) - (assert-equal ____ (dotimes (i 5 stack) - (push i stack))))) + (assert-equal '(4 3 2 1 0) (dotimes (i 5 stack) + (push i stack))))) (define-test do ;; The macro DO accepts a list of variable bindings, a termination test with @@ -47,7 +47,7 @@ (do ((i 0 (1+ i))) ((> i 5)) (push i result)) - (assert-equal ____ result)) + (assert-equal '(0 1 2 3 4 5) (nreverse result))) ;; The epilogue of DO can return a value. (let ((result (do ((i 0 (1+ i)) ;; A variable bound by DO noes not need to be updated on @@ -55,7 +55,7 @@ (result '())) ((> i 5) (nreverse result)) (push i result)))) - (assert-equal ____ result))) + (assert-equal '(0 1 2 3 4 5) result))) (define-test loop-basic-form ;; The macro LOOP in its simple form loops forever. It is possible to stop the @@ -64,10 +64,10 @@ (loop (incf counter) (when (>= counter 100) (return counter))) - (assert-equal ___ loop-counter)) + (assert-equal 100 counter)) ;; The RETURN special form can return a value out of a LOOP. - (let ((loop-counter 0)) - (assert-equal ___ (loop (incf counter) + (let ((counter 0)) + (assert-equal 100 (loop (incf counter) (when (>= counter 100) (return counter))))) ;; The extended form of LOOP will be contemplated in a future koan. diff --git a/koans-solved/loops.lisp b/koans-solved/loops.lisp index 85429bdd..9b55c903 100644 --- a/koans-solved/loops.lisp +++ b/koans-solved/loops.lisp @@ -20,9 +20,9 @@ (let* ((result-1 (loop for letter in '(#\a \b #\c #\d) collect letter)) (result-2 (loop for number in '(1 2 3 4 5) sum number)) (result-3 (loop for list in '((foo) (bar) (baz)) append list))) - (assert-equal ____ result-1) - (assert-equal ____ result-2) - (assert-equal ____ result-3))) + (assert-equal '(#\a \b #\c #\d) result-1) + (assert-equal 15 result-2) + (assert-equal '(foo bar baz) result-3))) (define-test loop-multiple-variables ;; With multiple FOR clauses, the loop ends when any of the provided lists are @@ -31,7 +31,7 @@ (result (loop for letter in letters for i from 1 to 1000 collect (list i letter)))) - (assert-equal ____ result))) + (assert-equal '((1 :a) (2 :b) (3 :c) (4 :d)) result))) (define-test loop-in-versus-loop-on ;; Instead of iterating over each element of a list, we can iterate over each @@ -39,18 +39,18 @@ (let* ((letters '(:a :b :c)) (result-in (loop for thing in letters collect thing)) (result-on (loop for thing on letters collect thing))) - (assert-equal ____ result-in) - (assert-equal ____ result-on))) + (assert-equal '(:a :b :c) result-in) + (assert-equal '((:a :b :c) (:b :c) (:c)) result-on))) (define-test loop-for-by ;; Numeric iteration can go faster or slower if we use the BY keyword. (let* ((result (loop for i from 0 to 30 by 5 collect i))) - (assert-equal ____ result))) + (assert-equal '(0 5 10 15 20 25 30) result))) (define-test loop-counting-backwards ;; We can count downwards instead of upwards by using DOWNTO instead of TO. (let ((result (loop for i from 5 downto -5 collect i))) - (assert-equal ____ result))) + (assert-equal '(5 4 3 2 1 0 -1 -2 -3 -4 -5) result))) (define-test loop-list-by ;; List iteration can go faster or slower if we use the BY keyword. @@ -59,31 +59,31 @@ (result-cdr (loop for letter in letters by #'cdr collect letter)) (result-cddr (loop for letter in letters by #'cddr collect letter)) (result-cdddr (loop for letter in letters by #'cdddr collect letter))) - (assert-equal ____ result-in) - (assert-equal ____ result-in-cdr) - (assert-equal ____ result-in-cddr) - (assert-equal ____ result-in-cdddr))) + (assert-equal '(:a :b :c :d :e :f) result) + (assert-equal '(:a :b :c :d :e :f) result-cdr) + (assert-equal '(:a :c :e) result-cddr) + (assert-equal '(:a :d) result-cdddr))) (define-test loop-across ;; LOOP can iterate over a vector with the ACROSS keyword. (let* ((vector (make-array '(5) :initial-contents '(0 1 2 3 4))) (result (loop for number across vector collect number))) - (assert-equal ____ result))) + (assert-equal '(0 1 2 3 4) result))) (define-test loop-over-2d-array (let ((array (make-array '(3 2) :initial-contents '((0 1) (2 3) (4 5))))) ;; LOOP can be combined with ROW-MAJOR-AREF to iterate over the contents of ;; a multidimensional array. (let* ((result (loop for i from 0 below (array-total-size array) - collect (row-major-aref my-array i)))) - (assert-equal ____ result)) + collect (row-major-aref array i)))) + (assert-equal '(0 1 2 3 4 5) result)) ;; It is always possible to resort to nested loops. (let* ((result (loop with max-i = (array-dimension array 0) for i from 0 below max-i collect (loop with max-j = (array-dimension array 1) for j from 0 below max-j - collect (expt (aref my-array i j) 2))))) - (assert-equal ____ result)))) + collect (expt (aref array i j) 2))))) + (assert-equal '((0 1) (4 9) (16 25)) result)))) (define-test loop-hash-table (let ((book-heroes (make-hash-table :test 'equal))) @@ -92,12 +92,12 @@ (gethash "The Wizard Of Oz" book-heroes) "Dorothy" (gethash "The Great Gatsby" book-heroes) "James Gatz") ;; LOOP can iterate over hash tables. - (let (pairs-in-table (loop for key being the hash-key of book-heroes - using (hash-value value) - collect (list key value))) - (assert-equal ____ (length pairs-in-table)) - (true-or-false? ____ (find '("The Hobbit" "Bilbo") pairs-in-table - :test #'equal))))) + (let ((pairs-in-table (loop for key being the hash-key of book-heroes + using (hash-value value) + collect (list key value)))) + (assert-equal 4 (length pairs-in-table)) + (true-or-false? t (find '("The Hobbit" "Bilbo") pairs-in-table + :test #'equal))))) (define-test loop-statistics ;; LOOP can perform basics statistics on the collected elements. @@ -110,11 +110,11 @@ finally (return (list collected counted summed maximized minimized))))) (destructuring-bind (collected counted summed maximized minimized) result - (assert-equal ____ collected) - (assert-equal ____ counted) - (assert-equal ____ summed) - (assert-equal ____ maximized) - (assert-equal ____ minimized)))) + (assert-equal '(1 2 4 8 16 32) collected) + (assert-equal 6 counted) + (assert-equal 63 summed) + (assert-equal 32 maximized) + (assert-equal 1 minimized)))) (define-test loop-destructuring ;; LOOP can bind multiple variables on each iteration step. @@ -122,19 +122,19 @@ (result (loop for (a b) in '((1 9) (2 8) (3 7) (4 6)) do (incf count) collect (+ a b)))) - (assert-equal ____ count) - (assert-equal ____ result))) + (assert-equal 4 count) + (assert-equal '(10 10 10 10) result))) -(define-test conditional-execution +(define-test loop-conditional-execution (let ((numbers '(1 1 2 3 5 8 13 21))) ;; LOOP can execute some actions conditionally. (let ((result (loop for x in numbers when (evenp x) sum x))) - (assert-equal ____ result)) + (assert-equal 10 result)) (let ((result (loop for x in numbers unless (evenp x) sum x))) - (assert-equal ____ result)) + (assert-equal 44 result)) (flet ((greater-than-10-p (x) (> x 10))) (let ((result (loop for x in numbers - when (greater-than-10-p 10) sum x))) - (assert-equal ____ result))))) + when (greater-than-10-p x) sum x))) + (assert-equal 34 result))))) diff --git a/koans-solved/mapcar-and-reduce.lisp b/koans-solved/mapcar-and-reduce.lisp index 4df282a6..57743479 100644 --- a/koans-solved/mapcar-and-reduce.lisp +++ b/koans-solved/mapcar-and-reduce.lisp @@ -19,79 +19,84 @@ ;; Inside MAPCAR, he function 1+ will be applied to each element of NUMBERS. ;; A new list will be collected from the results. (assert-equal '(2 3 4 5 6 7) (mapcar #'1+ numbers)) - (assert-equal ____ (mapcar #'- numbers)) - (assert-equal ____ (mapcar #'list numbers)) - (assert-equal ____ (mapcar #'evenp numbers)) - (assert-equal ____ (mapcar #'numberp numbers)) - (assert-equal ____ (mapcar #'stringp numbers)) + (assert-equal '(-1 -2 -3 -4 -5 -6) (mapcar #'- numbers)) + (assert-equal '((1) (2) (3) (4) (5) (6)) (mapcar #'list numbers)) + (assert-equal '(nil t nil t nil t) (mapcar #'evenp numbers)) + (assert-equal '(t t t t t t) (mapcar #'numberp numbers)) + (assert-equal '(nil nil nil nil nil nil) (mapcar #'stringp numbers)) ;; MAPCAR can work on multiple lists. The function will receive one argument ;; from each list. - (let (other-numbers '(4 8 15 16 23 42)) - (assert-equal ____ (mapcar #'+ numbers other-numbers)) - (assert-equal ____ (mapcar #'* numbers other-numbers)) + (let ((other-numbers '(4 8 15 16 23 42))) + (assert-equal '(5 10 18 20 28 48) (mapcar #'+ numbers other-numbers)) + (assert-equal '(4 16 45 64 115 252) (mapcar #'* numbers other-numbers)) ;; The function MOD performs modulo division. - (assert-equal ____ (mapcar #'mod other-numbers numbers))))) + (assert-equal '(0 0 0 0 3 0) (mapcar #'mod other-numbers numbers))))) (define-test mapcar-lambda ;; MAPCAR is often used with anonymous functions. (let ((numbers '(8 21 152 37 403 14 7 -34))) - (assert-equal ____ (mapcar (lambda (x) (mod x 10)) numbers))) + (assert-equal '(8 1 2 7 3 4 7 6) (mapcar (lambda (x) (mod x 10)) numbers))) (let ((strings '("Mary had a little lamb" "Old McDonald had a farm" "Happy birthday to you"))) - (assert-equal ____ (mapcar (lambda (x) (subseq x 4 12)) strings)))) + (assert-equal '(" had a l" "McDonald" "y birthd") + (mapcar (lambda (x) (subseq x 4 12)) strings)))) (define-test map ;; MAP is a variant of MAPCAR that works on any sequences. ;; It allows to specify the type of the resulting sequence. (let ((string "lorem ipsum")) - (assert-equal ____ (map 'string #'char-upcase string)) - (assert-equal ____ (map 'list #'char-upcase string)) + (assert-equal "LOREM IPSUM" (map 'string #'char-upcase string)) + (assert-equal '(#\L #\O #\R #\E #\M #\Space #\I #\P #\S #\U #\M) + (map 'list #'char-upcase string)) ;; Not all vectors containing characters are strings. - (assert-equal ____ (map '(vector t) #'char-upcase string)))) + (assert-equalp #(#\L #\O #\R #\E #\M #\Space #\I #\P #\S #\U #\M) + (map '(vector t) #'char-upcase string)))) (define-test transposition ;; MAPCAR gives the function as many arguments as there are lists. - (flet ((transpose (lists) (apply #'mapcar ____ lists))) + (flet ((transpose (lists) (apply #'mapcar #'list lists))) (let ((list '((1 2 3) (4 5 6) (7 8 9))) (transposed-list '((1 4 7) (2 5 8) - (3 6 9))))) - (assert-equal transposed-list (transpose list)) - (assert-equal ____ (transpose (transpose list)))) - (assert-equal ____ (transpose '(("these" "making") - ("pretzels" "me") - ("are" "thirsty"))))) + (3 6 9)))) + (assert-equal transposed-list (transpose list)) + (assert-equal list (transpose (transpose list)))) + (assert-equal '(("these" "pretzels" "are") + ("making" "me" "thirsty")) + (transpose '(("these" "making") + ("pretzels" "me") + ("are" "thirsty")))))) (define-test reduce ;; The function REDUCE combines the elements of a list by applying a binary ;; function to the elements of a sequence from left to right. (assert-equal 15 (reduce #'+ '(1 2 3 4 5))) - (assert-equal ____ (reduce #'+ '(1 2 3 4))) - (assert-equal ____ (reduce #'expt '(1 2 3 4 5)))) + (assert-equal 10 (reduce #'+ '(1 2 3 4))) + (assert-equal 1 (reduce #'expt '(1 2 3 4 5)))) (define-test reduce-from-end ;; The :FROM-END keyword argument can be used to reduce from right to left. (let ((numbers '(1 2 3 4 5))) - (assert-equal ____ (reduce #'cons numbers)) - (assert-equal ____ (reduce #'cons numbers :from-end t))) + (assert-equal '((((1 . 2) . 3) . 4) . 5) (reduce #'cons numbers)) + (assert-equal '(1 2 3 4 . 5) (reduce #'cons numbers :from-end t))) (let ((numbers '(2 3 2))) - (assert-equal ____ (reduce #'expt numbers)) - (assert-equal ____ (reduce #'expt numbers :from-end t)))) + (assert-equal 64 (reduce #'expt numbers)) + (assert-equal 512 (reduce #'expt numbers :from-end t)))) (define-test reduce-initial-value ;; :INITIAL-VALUE can supply the initial value for the reduction. (let ((numbers '(1 2 3 4 5))) - (assert-equal ____ (reduce #'* numbers)) - (assert-equal ____ (reduce #'* numbers :initial-value 0)) - (assert-equal ____ (reduce #'* numbers :initial-value -1)))) + (assert-equal 120 (reduce #'* numbers)) + (assert-equal 0 (reduce #'* numbers :initial-value 0)) + (assert-equal -120 (reduce #'* numbers :initial-value -1)))) (define-test inner-product ;; MAPCAR and REDUCE are powerful when used together. ;; Fill in the blanks to produce a local function that computes an inner ;; product of two vectors. - (flet ((inner-product (x y) (reduce ____ (mapcar ____ x y)))) + (flet ((inner-product (x y) (reduce #'+ (mapcar #'* x y)))) (assert-equal 32 (inner-product '(1 2 3) '(4 5 6))) (assert-equal 310 (inner-product '(10 20 30) '(4 3 7))))) diff --git a/koans/control-statements.lisp b/koans/control-statements.lisp index a5952854..04929b67 100644 --- a/koans/control-statements.lisp +++ b/koans/control-statements.lisp @@ -50,10 +50,10 @@ (assert-equal ____ (let ((x 0)) (and - (setf x (+ 1 x)) - (setf x (+ 1 x)) + (setf x (+ 2 x)) + (setf x (+ 3 x)) nil - (setf x (+ 1 x))) + (setf x (+ 4 x))) x))) (define-test or-short-circuit @@ -61,8 +61,8 @@ (assert-equal ____ (let ((x 0)) (or - (setf x (+ 1 x)) - (setf x (+ 1 x)) + (setf x (+ 2 x)) + (setf x (+ 3 x)) nil - (setf x (+ 1 x))) + (setf x (+ 4 x))) x))) diff --git a/koans/iteration.lisp b/koans/iteration.lisp index e820bc51..5268a3b1 100644 --- a/koans/iteration.lisp +++ b/koans/iteration.lisp @@ -64,12 +64,12 @@ (loop (incf counter) (when (>= counter 100) (return counter))) - (assert-equal ___ loop-counter)) + (assert-equal ____ counter)) ;; The RETURN special form can return a value out of a LOOP. - (let ((loop-counter 0)) - (assert-equal ___ (loop (incf counter) - (when (>= counter 100) - (return counter))))) + (let ((counter 0)) + (assert-equal ____ (loop (incf counter) + (when (>= counter 100) + (return counter))))) ;; The extended form of LOOP will be contemplated in a future koan. ) diff --git a/koans/loops.lisp b/koans/loops.lisp index 85429bdd..00fb7b5f 100644 --- a/koans/loops.lisp +++ b/koans/loops.lisp @@ -59,10 +59,10 @@ (result-cdr (loop for letter in letters by #'cdr collect letter)) (result-cddr (loop for letter in letters by #'cddr collect letter)) (result-cdddr (loop for letter in letters by #'cdddr collect letter))) - (assert-equal ____ result-in) - (assert-equal ____ result-in-cdr) - (assert-equal ____ result-in-cddr) - (assert-equal ____ result-in-cdddr))) + (assert-equal ____ result) + (assert-equal ____ result-cdr) + (assert-equal ____ result-cddr) + (assert-equal ____ result-cdddr))) (define-test loop-across ;; LOOP can iterate over a vector with the ACROSS keyword. @@ -75,14 +75,14 @@ ;; LOOP can be combined with ROW-MAJOR-AREF to iterate over the contents of ;; a multidimensional array. (let* ((result (loop for i from 0 below (array-total-size array) - collect (row-major-aref my-array i)))) + collect (row-major-aref array i)))) (assert-equal ____ result)) ;; It is always possible to resort to nested loops. (let* ((result (loop with max-i = (array-dimension array 0) for i from 0 below max-i collect (loop with max-j = (array-dimension array 1) for j from 0 below max-j - collect (expt (aref my-array i j) 2))))) + collect (expt (aref array i j) 2))))) (assert-equal ____ result)))) (define-test loop-hash-table @@ -92,9 +92,9 @@ (gethash "The Wizard Of Oz" book-heroes) "Dorothy" (gethash "The Great Gatsby" book-heroes) "James Gatz") ;; LOOP can iterate over hash tables. - (let (pairs-in-table (loop for key being the hash-key of book-heroes - using (hash-value value) - collect (list key value))) + (let ((pairs-in-table (loop for key being the hash-key of book-heroes + using (hash-value value) + collect (list key value)))) (assert-equal ____ (length pairs-in-table)) (true-or-false? ____ (find '("The Hobbit" "Bilbo") pairs-in-table :test #'equal))))) @@ -125,7 +125,7 @@ (assert-equal ____ count) (assert-equal ____ result))) -(define-test conditional-execution +(define-test loop-conditional-execution (let ((numbers '(1 1 2 3 5 8 13 21))) ;; LOOP can execute some actions conditionally. (let ((result (loop for x in numbers @@ -136,5 +136,5 @@ (assert-equal ____ result)) (flet ((greater-than-10-p (x) (> x 10))) (let ((result (loop for x in numbers - when (greater-than-10-p 10) sum x))) + when (greater-than-10-p x) sum x))) (assert-equal ____ result))))) diff --git a/koans/mapcar-and-reduce.lisp b/koans/mapcar-and-reduce.lisp index 4df282a6..76dfa830 100644 --- a/koans/mapcar-and-reduce.lisp +++ b/koans/mapcar-and-reduce.lisp @@ -26,7 +26,7 @@ (assert-equal ____ (mapcar #'stringp numbers)) ;; MAPCAR can work on multiple lists. The function will receive one argument ;; from each list. - (let (other-numbers '(4 8 15 16 23 42)) + (let ((other-numbers '(4 8 15 16 23 42))) (assert-equal ____ (mapcar #'+ numbers other-numbers)) (assert-equal ____ (mapcar #'* numbers other-numbers)) ;; The function MOD performs modulo division. @@ -48,7 +48,7 @@ (assert-equal ____ (map 'string #'char-upcase string)) (assert-equal ____ (map 'list #'char-upcase string)) ;; Not all vectors containing characters are strings. - (assert-equal ____ (map '(vector t) #'char-upcase string)))) + (assert-equalp ____ (map '(vector t) #'char-upcase string)))) (define-test transposition ;; MAPCAR gives the function as many arguments as there are lists. @@ -58,12 +58,12 @@ (7 8 9))) (transposed-list '((1 4 7) (2 5 8) - (3 6 9))))) - (assert-equal transposed-list (transpose list)) - (assert-equal ____ (transpose (transpose list)))) - (assert-equal ____ (transpose '(("these" "making") - ("pretzels" "me") - ("are" "thirsty"))))) + (3 6 9)))) + (assert-equal transposed-list (transpose list)) + (assert-equal ____ (transpose (transpose list)))) + (assert-equal ____ (transpose '(("these" "making") + ("pretzels" "me") + ("are" "thirsty")))))) (define-test reduce ;; The function REDUCE combines the elements of a list by applying a binary diff --git a/koans/scoring-project.lisp b/koans/scoring-project.lisp index 33aea48a..9e2e35d8 100644 --- a/koans/scoring-project.lisp +++ b/koans/scoring-project.lisp @@ -50,7 +50,7 @@ ;;; Your goal is to write the scoring function for Greed. (defun score (&rest dice) - ____) + ) (define-test score-of-an-empty-list-is-zero (assert-equal 0 (score))) diff --git a/lisp-koans.lisp b/lisp-koans.lisp index ce8300d4..58224003 100644 --- a/lisp-koans.lisp +++ b/lisp-koans.lisp @@ -90,7 +90,7 @@ (t (format nil "Last koan status: ~A." koan-status)))) (defun print-next-suggestion-message (dirname) - (let ((filename (caar *collected-results*)) + (let ((filename (caar (last *collected-results*))) (koan-name (caaadr (car (last (last *collected-results*))))) (koan-status (reverse (cadaar (cdar (last (last *collected-results*))))))) (format t "~&You have not yet reached enlightenment. From 30dd96100bd90fc2b4efef73116de130901eab2a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Sat, 9 May 2020 09:53:09 +0200 Subject: [PATCH 102/133] More fixes --- koans-solved/clos.lisp | 85 +++++++++--------- koans-solved/format.lisp | 89 ++++++++++++------- koans-solved/scoring-project.lisp | 17 +++- koans-solved/type-checking.lisp | 141 +++++++++++++++--------------- koans/clos.lisp | 15 +++- koans/scoring-project.lisp | 2 +- koans/type-checking.lisp | 13 +-- test-framework.lisp | 2 +- 8 files changed, 210 insertions(+), 154 deletions(-) diff --git a/koans-solved/clos.lisp b/koans-solved/clos.lisp index 2429352e..25a37a6e 100644 --- a/koans-solved/clos.lisp +++ b/koans-solved/clos.lisp @@ -27,15 +27,22 @@ (setf (slot-value car-1 'speed) 220) (setf (slot-value car-2 'color) :blue) (setf (slot-value car-2 'speed) 240) - (assert-equal ____ (slot-value car-1 'color)) - (assert-equal ____ (slot-value car-2 'speed)))) + (assert-equal :red (slot-value car-1 'color)) + (assert-equal 240 (slot-value car-2 'speed)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Common Lisp predefines the symbol SPEED in the COMMON-LISP package, which +;;; means that we cannot define a function named after it. The function SHADOW +;;; creates a new symbol with the same name in the current package and shadows +;;; the predefined one within the current package. + +(shadow 'speed) + (defclass spaceship () ;; It is possible to define reader, writer, and accessor functions for slots. ((color :reader color :writer (setf color)) - (speed :accessor color))) + (speed :accessor speed))) ;;; Specifying a reader function named COLOR is equivalent to ;;; (DEFMETHOD COLOR ((OBJECT SPACECSHIP)) ...) @@ -47,20 +54,20 @@ (let ((ship (make-instance 'spaceship))) (setf (color ship) :orange (speed ship) 1000) - (assert-equal ____ (color ship)) - (assert-equal ____ (speed ship)))) + (assert-equal :orange (color ship)) + (assert-equal 1000 (speed ship)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defclass bike () ;; It is also possible to define initial arguments for slots. ((color :reader color :initarg :color) - (speed :reader color :initarg :color))) + (speed :reader speed :initarg :speed))) (define-test initargs (let ((bike (make-instance 'bike :color :blue :speed 30))) - (assert-equal ____ (color bike)) - (assert-equal ____ (speed bike)))) + (assert-equal :blue (color bike)) + (assert-equal 30 (speed bike)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -84,15 +91,15 @@ :favorite-lisp-implementation :sbcl)) (adam (make-instance 'c-programmer :name :adam - :favorite-c-compiler :llvm))) - (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)))) + :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. @@ -103,13 +110,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 'embeddable-common-lisp-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)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -133,17 +140,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)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -168,7 +175,7 @@ (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)))) diff --git a/koans-solved/format.lisp b/koans-solved/format.lisp index 39d0e6fa..7297b31c 100644 --- a/koans-solved/format.lisp +++ b/koans-solved/format.lisp @@ -22,63 +22,88 @@ (define-test format-basic ;; If there are no format directives in the string, FORMAT will return ;; a string that is STRING= to its format control. - (assert-equal ____ (format nil "Lorem ipsum dolor sit amet"))) + (assert-equal "Lorem ipsum dolor sit amet" + (format nil "Lorem ipsum dolor sit amet"))) (define-test format-aesthetic ;; The ~A format directive creates aesthetic output. - (assert-equal ____ (format nil "This is the number ~A" 42)) - (assert-equal ____ (format nil "This is the keyword ~A" :foo)) - (assert-equal ____ (format nil "~A evaluates to ~A" - '(/ 24 (- 3 (/ 8 3))) - (/ 24 (- 3 (/ 8 3))))) - (assert-equal ____ (format nil "This is the character ~A" #\C)) - (assert-equal ____ (format nil "In a ~A" "galaxy far far away"))) + (assert-equal "This is the number 42" + (format nil "This is the number ~A" 42)) + (assert-equal "This is the keyword FOO" + (format nil "This is the keyword ~A" :foo)) + (assert-equal "(/ 24 (- 3 (/ 8 3))) evaluates to 72" + (format nil "~A evaluates to ~A" + '(/ 24 (- 3 (/ 8 3))) + (/ 24 (- 3 (/ 8 3))))) + (assert-equal "This is the character C" + (format nil "This is the character ~A" #\C)) + (assert-equal "In a galaxy far far away" + (format nil "In a ~A" "galaxy far far away"))) (define-test format-standard ;; The ~S format directive prints objects with escape characters. ;; Not all Lisp objects require to be escaped. - (assert-equal ____ (format nil "This is the number ~S" 42)) - (assert-equal ____ (format nil "~S evaluates to ~S" - '(/ 24 (- 3 (/ 8 3))) - (/ 24 (- 3 (/ 8 3))))) + (assert-equal "This is the number 42" (format nil "This is the number ~S" 42)) + (assert-equal "(/ 24 (- 3 (/ 8 3))) evaluates to 72" + (format nil "~S evaluates to ~S" + '(/ 24 (- 3 (/ 8 3))) + (/ 24 (- 3 (/ 8 3))))) ;; Keywords are printed with their leading colon. - (assert-equal ____ (format nil "This is the keyword ~S" :foo)) + (assert-equal "This is the keyword :FOO" + (format nil "This is the keyword ~S" :foo)) ;; Characters are printed in their #\X form. The backslash will need to be ;; escaped inside the printed string, just like in "#\\X". - (assert-equal ____ (format nil "This is the character ~S" #\C)) + (assert-equal "This is the character #\\C" + (format nil "This is the character ~S" #\C)) ;; Strings include quote characters, which must be escaped: ;; such a string might look in code like "foo \"bar\"". - (assert-equal ____ (format nil "In a ~S" "galaxy far far away"))) + (assert-equal "In a \"galaxy far far away\"" + (format nil "In a ~S" "galaxy far far away"))) (define-test format-radix ;; The ~B, ~O, ~D, and ~X radices print numbers in binary, octal, decimal, and ;; hexadecimal notation. - (assert-equal ____ (format nil "This is the number ~B" 42)) - (assert-equal ____ (format nil "This is the number ~O" 42)) - (assert-equal ____ (format nil "This is the number ~D" 42)) - (assert-equal ____ (format nil "This is the number ~X" 42)) + (assert-equal "This is the number 101010" + (format nil "This is the number ~B" 42)) + (assert-equal "This is the number 52" + (format nil "This is the number ~O" 42)) + (assert-equal "This is the number 42" + (format nil "This is the number ~D" 42)) + (assert-equal "This is the number 2A" + (format nil "This is the number ~X" 42)) ;; We can specify a custom radix by using the ~R directive. - (assert-equal ____ (format nil "This is the number ~3R" 42)) + (assert-equal "This is the number 1120" + (format nil "This is the number ~3R" 42)) ;; It is possible to print whole forms this way. (let ((form '(/ 24 (- 3 (/ 8 3)))) (result (/ 24 (- 3 (/ 8 3))))) - (assert-equal ____ (format nil "~B evaluates to ~B" form result)) - (assert-equal ____ (format nil "~O evaluates to ~O" form result)) - (assert-equal ____ (format nil "~D evaluates to ~D" form result)) - (assert-equal ____ (format nil "~X evaluates to ~X" form result)) - (assert-equal ____ (format nil "~3R evaluates to ~3R" form result)))) + (assert-equal "(/ 11000 (- 11 (/ 1000 11))) evaluates to 1001000" + (format nil "~B evaluates to ~B" form result)) + (assert-equal "(/ 30 (- 3 (/ 10 3))) evaluates to 110" + (format nil "~O evaluates to ~O" form result)) + (assert-equal "(/ 24 (- 3 (/ 8 3))) evaluates to 72" + (format nil "~D evaluates to ~D" form result)) + (assert-equal "(/ 18 (- 3 (/ 8 3))) evaluates to 48" + (format nil "~X evaluates to ~X" form result)) + (assert-equal "(/ 220 (- 10 (/ 22 10))) evaluates to 2200" + (format nil "~3R evaluates to ~3R" form result)))) (define-test format-iteration ;; The ~{ and ~} directives iterate over a list. - (assert-equal ____ (format nil "~{[~A]~}" '(1 2 3 4 5 6))) - (assert-equal ____ (format nil "~{[~A ~A]~}" '(1 2 3 4 5 6))) + (assert-equal "[1][2][3][4][5][6]" (format nil "~{[~A]~}" '(1 2 3 4 5 6))) + (assert-equal "[1 2][3 4][5 6]" (format nil "~{[~A ~A]~}" '(1 2 3 4 5 6))) ;; The directive ~^ aborts iteration when no more elements remain. - (assert-equal ____ (format nil "~{[~A]~^, ~}" '(1 2 3 4 5 6)))) + (assert-equal "[1], [2], [3], [4], [5], [6]" + (format nil "~{[~A]~^, ~}" '(1 2 3 4 5 6)))) (define-test format-case ;; The ~( and ~) directives adjust the string case. - (assert-equal ____ (format nil "~(~A~)" "The QuIcK BROWN fox")) + (assert-equal "the quick brown fox" + (format nil "~(~A~)" "The QuIcK BROWN fox")) ;; Some FORMAT directives can be further adjusted with the : and @ modifiers. - (assert-equal ____ (format nil "~:(~A~)" "The QuIcK BROWN fox")) - (assert-equal ____ (format nil "~@(~A~)" "The QuIcK BROWN fox")) - (assert-equal ____ (format nil "~:@(~A~)" "The QuIcK BROWN fox"))) + (assert-equal "The Quick Brown Fox" + (format nil "~:(~A~)" "The QuIcK BROWN fox")) + (assert-equal "The quick brown fox" + (format nil "~@(~A~)" "The QuIcK BROWN fox")) + (assert-equal "THE QUICK BROWN FOX" + (format nil "~:@(~A~)" "The QuIcK BROWN fox"))) diff --git a/koans-solved/scoring-project.lisp b/koans-solved/scoring-project.lisp index 33aea48a..9cb34ff8 100644 --- a/koans-solved/scoring-project.lisp +++ b/koans-solved/scoring-project.lisp @@ -49,8 +49,23 @@ ;;; ;;; Your goal is to write the scoring function for Greed. +(defun score-once (&rest dice) + (let ((sorted (sort (copy-list dice) #'<))) + (cond ((search '(1 1 1) sorted) (list 1000 (remove 1 sorted :count 3))) + ((search '(2 2 2) sorted) (list 200 (remove 2 sorted :count 3))) + ((search '(3 3 3) sorted) (list 300 (remove 3 sorted :count 3))) + ((search '(4 4 4) sorted) (list 400 (remove 4 sorted :count 3))) + ((search '(5 5 5) sorted) (list 500 (remove 5 sorted :count 3))) + ((search '(6 6 6) sorted) (list 600 (remove 6 sorted :count 3))) + ((find 5 sorted) (list 50 (remove 5 sorted :count 1))) + ((find 1 sorted) (list 100 (remove 1 sorted :count 1))) + (t (list 0 '()))))) + (defun score (&rest dice) - ____) + (loop for current-dice = dice then remaining-dice + for (score remaining-dice) = (apply #'score-once current-dice) + sum score + while remaining-dice)) (define-test score-of-an-empty-list-is-zero (assert-equal 0 (score))) diff --git a/koans-solved/type-checking.lisp b/koans-solved/type-checking.lisp index 62c6c11a..8afb5e29 100644 --- a/koans-solved/type-checking.lisp +++ b/koans-solved/type-checking.lisp @@ -18,30 +18,30 @@ (define-test typep ;; TYPEP returns true if the provided object is of the provided type. - (true-or-false? ____ (typep "hello" 'string)) - (true-or-false? ____ (typep "hello" 'array)) - (true-or-false? ____ (typep "hello" 'list)) - (true-or-false? ____ (typep "hello" '(simple-array character (5)))) - (true-or-false? ____ (typep '(1 2 3) 'list)) - (true-or-false? ____ (typep 99 'integer)) - (true-or-false? ____ (typep nil 'NULL)) - (true-or-false? ____ (typep 22/7 'ratio)) - (true-or-false? ____ (typep 4.0 'float)) - (true-or-false? ____ (typep #\a 'character)) - (true-or-false? ____ (typep #'length 'function))) + (true-or-false? t (typep "hello" 'string)) + (true-or-false? t (typep "hello" 'array)) + (true-or-false? nil (typep "hello" 'list)) + (true-or-false? t (typep "hello" '(simple-array character (5)))) + (true-or-false? t (typep '(1 2 3) 'list)) + (true-or-false? t (typep 99 'integer)) + (true-or-false? t (typep nil 'NULL)) + (true-or-false? t (typep 22/7 'ratio)) + (true-or-false? t (typep 4.0 'float)) + (true-or-false? t (typep #\a 'character)) + (true-or-false? t (typep #'length 'function))) (define-test type-of ;; TYPE-OF returns a type specifier for the object. - (assert-equal ____ (type-of '())) - (assert-equal ____ (type-of 4/6))) + (assert-equal 'null (type-of '())) + (assert-equal 'ratio (type-of 4/6))) (define-test overlapping-types ;; Because Lisp types are mathematical sets, they are allowed to overlap. (let ((thing '())) - (true-or-false? ____ (typep thing 'list)) - (true-or-false? ____ (typep thing 'atom)) - (true-or-false? ____ (typep thing 'null)) - (true-or-false? ____ (typep thing 't)))) + (true-or-false? t (typep thing 'list)) + (true-or-false? t (typep thing 'atom)) + (true-or-false? t (typep thing 'null)) + (true-or-false? t (typep thing 't)))) (define-test fixnum-versus-bignum ;; In Lisp, integers are either fixnums or bignums. Fixnums are handled more @@ -54,20 +54,20 @@ (integer-2 most-positive-fixnum) (integer-3 (1+ most-positive-fixnum)) (integer-4 (1- most-negative-fixnum))) - (true-or-false? ____ (typep integer-1 'fixunm)) - (true-or-false? ____ (typep integer-1 'bignum)) - (true-or-false? ____ (typep integer-2 'fixnum)) - (true-or-false? ____ (typep integer-2 'bignum)) - (true-or-false? ____ (typep integer-3 'fixnum)) - (true-or-false? ____ (typep integer-3 'bignum)) - (true-or-false? ____ (typep integer-4 'fixnum)) - (true-or-false? ____ (typep integer-4 'bignum)) + (true-or-false? t (typep integer-1 'fixnum)) + (true-or-false? nil (typep integer-1 'bignum)) + (true-or-false? t (typep integer-2 'fixnum)) + (true-or-false? nil (typep integer-2 'bignum)) + (true-or-false? nil (typep integer-3 'fixnum)) + (true-or-false? t (typep integer-3 'bignum)) + (true-or-false? nil (typep integer-4 'fixnum)) + (true-or-false? t (typep integer-4 'bignum)) ;; Regardless of whether an integer is a fixnum or a bignum, it is still ;; an integer. - (true-or-false? ____ (typep integer-1 'integer)) - (true-or-false? ____ (typep integer-2 'integer)) - (true-or-false? ____ (typep integer-3 'integer)) - (true-or-false? ____ (typep integer-4 'integer)))) + (true-or-false? t (typep integer-1 'integer)) + (true-or-false? t (typep integer-2 'integer)) + (true-or-false? t (typep integer-3 'integer)) + (true-or-false? t (typep integer-4 'integer)))) (define-test subtypep (assert-true (typep 1 'bit)) @@ -76,9 +76,10 @@ (assert-true (typep 2 'integer)) ;; The function SUBTYPEP attempts to answer whether one type specifier ;; represents a subtype of the other type specifier. - (true-or-false? ____ (subtypep 'bit 'integer)) - (true-or-false? ____ (subtypep (type-of 1) (type-of 2))) - (true-or-false? ____ (subtypep (type-of 2) (type-of 1)))) + (true-or-false? t (subtypep 'bit 'integer)) + (true-or-false? t (subtypep 'vector 'array)) + (true-or-false? t (subtypep 'string 'vector)) + (true-or-false? t (subtypep 'null 'list))) (define-test list-type-specifiers ;; Some type specifiers are lists; this way, they carry more information than @@ -87,66 +88,66 @@ (assert-true (typep (make-array 42) '(vector * 42))) (assert-true (typep (make-array 42 :element-type 'bit) '(vector bit 42))) (assert-true (typep (make-array '(4 2)) '(array * (4 2)))) - (true-or-false? ____ (typep (make-array '(3 3)) '(simple-array t (3 3)))) - (true-or-false? ____ (typep (make-array '(3 2 1)) '(simple-array t (1 2 3))))) + (true-or-false? t (typep (make-array '(3 3)) '(simple-array t (3 3)))) + (true-or-false? nil (typep (make-array '(3 2 1)) '(simple-array t (1 2 3))))) (define-test list-type-specifiers-hierarchy ;; Type specifiers that are lists also follow hierarchy. - (true-or-false? ____ (subtypep '(simple-array t (3 3)) '(simple-array t *))) - (true-or-false? ____ (subtypep '(vector double-float 100) '(vector * 100))) - (true-or-false? ____ (subtypep '(vector double-float 100) '(vector double-float *))) - (true-or-false? ____ (subtypep '(vector double-float 100) '(vector * *))) - (true-or-false? ____ (subtypep '(vector double-float 100) '(array number *))) - (true-or-false? ____ (subtypep '(vector double-float 100) t))) + (true-or-false? t (subtypep '(simple-array t (3 3)) '(simple-array t *))) + (true-or-false? t (subtypep '(vector double-float 100) '(vector * 100))) + (true-or-false? t (subtypep '(vector double-float 100) '(vector double-float *))) + (true-or-false? t (subtypep '(vector double-float 100) '(vector * *))) + (true-or-false? t (subtypep '(vector double-float 100) '(array * *))) + (true-or-false? t (subtypep '(vector double-float 100) t))) (define-test type-coercion (assert-true (typep 0 'integer)) - (true-or-false? ____ (typep 0 'short-float)) - (true-or-false? ____ (subtypep 'integer 'short-float)) - (true-or-false? ____ (subtypep 'short-float 'integer)) + (true-or-false? nil (typep 0 'short-float)) + (true-or-false? nil (subtypep 'integer 'short-float)) + (true-or-false? nil (subtypep 'short-float 'integer)) ;; The function COERCE makes it possible to convert values between some ;; standard types. - (true-or-false? ____ (typep (coerce 0 'short-float) 'short-float))) + (true-or-false? t (typep (coerce 0 'short-float) 'short-float))) (define-test atoms-are-anything-thats-not-a-cons ;; In Lisp, an atom is anything that is not a cons cell. The function ATOM ;; returns true if its object is an atom. - (true-or-false? ____ (atom 4)) - (true-or-false? ____ (atom '(1 2 3 4))) - (true-or-false? ____ (atom '(:foo . :bar))) - (true-or-false? ____ (atom 'symbol)) - (true-or-false? ____ (atom :keyword)) - (true-or-false? ____ (atom #(1 2 3 4 5))) - (true-or-false? ____ (atom #\A)) - (true-or-false? ____ (atom "string")) - (true-or-false? ____ (atom (make-array '(4 4))))) + (true-or-false? t (atom 4)) + (true-or-false? nil (atom '(1 2 3 4))) + (true-or-false? nil (atom '(:foo . :bar))) + (true-or-false? t (atom 'symbol)) + (true-or-false? t (atom :keyword)) + (true-or-false? t (atom #(1 2 3 4 5))) + (true-or-false? t (atom #\A)) + (true-or-false? t (atom "string")) + (true-or-false? t (atom (make-array '(4 4))))) (define-test functionp ;; The function FUNCTIONP returns true if its arguments is a function. (assert-true (functionp (lambda (a b c) (+ a b c)))) - (true-or-false? ____ (functionp #'make-array)) - (true-or-false? ____ (functionp 'make-array)) - (true-or-false? ____ (functionp (lambda (x) (* x x)))) - (true-or-false? ____ (functionp '(lambda (x) (* x x)))) - (true-or-false? ____ (functionp '(1 2 3))) - (true-or-false? ____ (functionp t))) + (true-or-false? t (functionp #'make-array)) + (true-or-false? nil (functionp 'make-array)) + (true-or-false? t (functionp (lambda (x) (* x x)))) + (true-or-false? nil (functionp '(lambda (x) (* x x)))) + (true-or-false? nil (functionp '(1 2 3))) + (true-or-false? nil (functionp t))) (define-test other-type-predicates ;; Lisp defines multiple type predicates for standard types.. - (true-or-false? ____ (numberp 999)) - (true-or-false? ____ (listp '(9 9 9))) - (true-or-false? ____ (integerp 999)) - (true-or-false? ____ (rationalp 9/99)) - (true-or-false? ____ (floatp 9.99)) - (true-or-false? ____ (stringp "nine nine nine")) - (true-or-false? ____ (characterp #\9)) - (true-or-false? ____ (bit-vector-p #*01001))) + (true-or-false? t (numberp 999)) + (true-or-false? t (listp '(9 9 9))) + (true-or-false? t (integerp 999)) + (true-or-false? t (rationalp 9/99)) + (true-or-false? t (floatp 9.99)) + (true-or-false? t (stringp "nine nine nine")) + (true-or-false? t (characterp #\9)) + (true-or-false? t (bit-vector-p #*01001))) (define-test guess-that-type ;; Fill in the blank with a type specifier that satisfies the following tests. - (let ((type ____)) - (assert-true (subtypep type '(simple-array t (* 3 *)))) - (assert-true (subtypep type '(simple-array t (5 * *)))) + (let ((type '(simple-array array (5 3 *)))) + (assert-true (subtypep type '(simple-array * (* 3 *)))) + (assert-true (subtypep type '(simple-array * (5 * *)))) (assert-true (subtypep type '(simple-array array *))) (assert-true (typep (make-array '(5 3 9) :element-type 'string) type)) (assert-true (typep (make-array '(5 3 33) :element-type 'vector) type)))) diff --git a/koans/clos.lisp b/koans/clos.lisp index 2429352e..44822d6f 100644 --- a/koans/clos.lisp +++ b/koans/clos.lisp @@ -32,10 +32,17 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Common Lisp predefines the symbol SPEED in the COMMON-LISP package, which +;;; means that we cannot define a function named after it. The function SHADOW +;;; creates a new symbol with the same name in the current package and shadows +;;; the predefined one within the current package. + +(shadow 'speed) + (defclass spaceship () ;; It is possible to define reader, writer, and accessor functions for slots. ((color :reader color :writer (setf color)) - (speed :accessor color))) + (speed :accessor speed))) ;;; Specifying a reader function named COLOR is equivalent to ;;; (DEFMETHOD COLOR ((OBJECT SPACECSHIP)) ...) @@ -55,7 +62,7 @@ (defclass bike () ;; It is also possible to define initial arguments for slots. ((color :reader color :initarg :color) - (speed :reader color :initarg :color))) + (speed :reader speed :initarg :speed))) (define-test initargs (let ((bike (make-instance 'bike :color :blue :speed 30))) @@ -84,7 +91,7 @@ :favorite-lisp-implementation :sbcl)) (adam (make-instance 'c-programmer :name :adam - :favorite-c-compiler :llvm))) + :favorite-c-compiler :clang))) (assert-equal ____ (person-name jack)) (assert-equal ____ (person-name bob)) (assert-equal ____ (favorite-lisp-implementation bob)) @@ -109,7 +116,7 @@ (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 'embeddable-common-lisp-programmer)))) + (true-or-false? ____ (typep zenon 'clisp-programmer)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/koans/scoring-project.lisp b/koans/scoring-project.lisp index 9e2e35d8..33aea48a 100644 --- a/koans/scoring-project.lisp +++ b/koans/scoring-project.lisp @@ -50,7 +50,7 @@ ;;; Your goal is to write the scoring function for Greed. (defun score (&rest dice) - ) + ____) (define-test score-of-an-empty-list-is-zero (assert-equal 0 (score))) diff --git a/koans/type-checking.lisp b/koans/type-checking.lisp index 62c6c11a..09a3b14f 100644 --- a/koans/type-checking.lisp +++ b/koans/type-checking.lisp @@ -54,7 +54,7 @@ (integer-2 most-positive-fixnum) (integer-3 (1+ most-positive-fixnum)) (integer-4 (1- most-negative-fixnum))) - (true-or-false? ____ (typep integer-1 'fixunm)) + (true-or-false? ____ (typep integer-1 'fixnum)) (true-or-false? ____ (typep integer-1 'bignum)) (true-or-false? ____ (typep integer-2 'fixnum)) (true-or-false? ____ (typep integer-2 'bignum)) @@ -77,8 +77,9 @@ ;; The function SUBTYPEP attempts to answer whether one type specifier ;; represents a subtype of the other type specifier. (true-or-false? ____ (subtypep 'bit 'integer)) - (true-or-false? ____ (subtypep (type-of 1) (type-of 2))) - (true-or-false? ____ (subtypep (type-of 2) (type-of 1)))) + (true-or-false? ____ (subtypep 'vector 'array)) + (true-or-false? ____ (subtypep 'string 'vector)) + (true-or-false? ____ (subtypep 'null 'list))) (define-test list-type-specifiers ;; Some type specifiers are lists; this way, they carry more information than @@ -96,7 +97,7 @@ (true-or-false? ____ (subtypep '(vector double-float 100) '(vector * 100))) (true-or-false? ____ (subtypep '(vector double-float 100) '(vector double-float *))) (true-or-false? ____ (subtypep '(vector double-float 100) '(vector * *))) - (true-or-false? ____ (subtypep '(vector double-float 100) '(array number *))) + (true-or-false? ____ (subtypep '(vector double-float 100) '(array * *))) (true-or-false? ____ (subtypep '(vector double-float 100) t))) (define-test type-coercion @@ -145,8 +146,8 @@ (define-test guess-that-type ;; Fill in the blank with a type specifier that satisfies the following tests. (let ((type ____)) - (assert-true (subtypep type '(simple-array t (* 3 *)))) - (assert-true (subtypep type '(simple-array t (5 * *)))) + (assert-true (subtypep type '(simple-array * (* 3 *)))) + (assert-true (subtypep type '(simple-array * (5 * *)))) (assert-true (subtypep type '(simple-array array *))) (assert-true (typep (make-array '(5 3 9) :element-type 'string) type)) (assert-true (typep (make-array '(5 3 33) :element-type 'vector) type)))) diff --git a/test-framework.lisp b/test-framework.lisp index 718ce5ad..2540a6ea 100644 --- a/test-framework.lisp +++ b/test-framework.lisp @@ -154,7 +154,7 @@ (defmacro assert-true (form) "Assert whether the form is true." - `(expand-assert :result ,form ,(notnot form) t)) + `(expand-assert :result ,form (notnot ,form) t)) ;;; Run the tests From 0083fdb5a83f7923384f617dc185af869f97da97 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Sat, 9 May 2020 10:56:29 +0200 Subject: [PATCH 103/133] Fix and complete everything, hopefully --- koans-solved/backquote.lisp | 38 +++--- koans-solved/condition-handlers.lisp | 178 +++++++++++++++------------ koans-solved/dice-project.lisp | 29 +++-- koans-solved/extra-credit.lisp | 18 +++ koans-solved/macros.lisp | 33 +++-- koans-solved/std-method-comb.lisp | 59 ++++----- koans-solved/triangle-project.lisp | 19 ++- koans/backquote.lisp | 2 +- koans/condition-handlers.lisp | 10 +- koans/dice-project.lisp | 19 +-- koans/extra-credit.lisp | 17 +++ koans/macros.lisp | 6 +- koans/std-method-comb.lisp | 23 ++-- koans/triangle-project.lisp | 6 +- lisp-koans.lisp | 5 +- test-framework.lisp | 6 +- 16 files changed, 277 insertions(+), 191 deletions(-) diff --git a/koans-solved/backquote.lisp b/koans-solved/backquote.lisp index d8e15fdb..e1a187d3 100644 --- a/koans-solved/backquote.lisp +++ b/koans-solved/backquote.lisp @@ -19,23 +19,25 @@ (let ((x '(123)) (z '(7 8 9))) ;; ' quotes an expression normally. - (assert-equal ____ '(x 45 6 z)) + (assert-equal '(x 45 6 z) '(x 45 6 z)) ;; ` backquotes an expression; without any unquotes, it is equivalent to ;; using the normal quote. - (assert-equal ____ `(x 45 6 z)) + (assert-equal '(x 45 6 z) `(x 45 6 z)) ;; , unquotes a part of the expression. - (assert-equal ____ `(,x 45 6 z)) - (assert-equal ____ `(,x 45 6 ,z)) + (assert-equal '((123) 45 6 z) `(,x 45 6 z)) + (assert-equal '((123) 45 6 (7 8 9)) `(,x 45 6 ,z)) ;; ,@ splices an expression into the into the list surrounding it. - (assert-equal ____ `(,x 45 6 ,@z)) - (assert-equal ____ `(,@x 45 6 ,@z)))) + (assert-equal '((123) 45 6 7 8 9) `(,x 45 6 ,@z)) + (assert-equal '(123 45 6 7 8 9) `(,@x 45 6 ,@z)))) (define-test backquote-forms ;; Because of its properties, backquote is useful for constructing Lisp forms ;; that are macroexpansions or parts of macroexpansions. (let ((variable 'x)) ;; Fill in the blank without without using backquote/unquote notation. - (assert-equal ____ + (assert-equal '(if (typep x 'string) + (format nil "The value of ~A is ~A" 'x x) + (error 'type-error :datum x :expected-type 'string)) `(if (typep ,variable 'string) (format nil "The value of ~A is ~A" ',variable ,variable) (error 'type-error :datum ,variable @@ -43,7 +45,9 @@ (let ((error-type 'type-error) (error-arguments '(:datum x :expected-type 'string))) ;; Fill in the blank without without using backquote/unquote notation. - (assert-equal ____ + (assert-equal '(if (typep x 'string) + (format nil "The value of ~A is ~A" 'x x) + (error 'type-error :datum x :expected-type 'string)) `(if (typep x 'string) (format nil "The value of ~A is ~A" 'x x) (error ',error-type ,@error-arguments))))) @@ -51,15 +55,17 @@ (define-test numbers-and-words (let ((number 5) (word 'dolphin)) - (true-or-false? ____ (equal '(1 3 5) `(1 3 5))) - (true-or-false? ____ (equal '(1 3 5) `(1 3 number))) - (assert-equal _____ `(1 3 ,number)) - (assert-equal _____ `(word ,word ,word word)))) + (true-or-false? t (equal '(1 3 5) `(1 3 5))) + (true-or-false? nil (equal '(1 3 5) `(1 3 number))) + (assert-equal '(1 3 5) `(1 3 ,number)) + (assert-equal '(word dolphin dolphin word) `(word ,word ,word word)))) (define-test splicing (let ((axis '(x y z))) - (assert-equal '(the axis are ____) `(the axis are ,axis)) - (assert-equal '(the axis are ____) `(the axis are ,@axis))) + (assert-equal '(the axis are (x y z)) `(the axis are ,axis)) + (assert-equal '(the axis are x y z) `(the axis are ,@axis))) (let ((coordinates '((43.15 77.6) (42.36 71.06)))) - (assert-equal ____ `(the coordinates are ,coordinates)) - (assert-equal ____ `(the coordinates are ,@coordinates)))) + (assert-equal '(the coordinates are ((43.15 77.6) (42.36 71.06))) + `(the coordinates are ,coordinates)) + (assert-equal '(the coordinates are (43.15 77.6) (42.36 71.06)) + `(the coordinates are ,@coordinates)))) diff --git a/koans-solved/condition-handlers.lisp b/koans-solved/condition-handlers.lisp index 24ae56a1..5ccb085d 100644 --- a/koans-solved/condition-handlers.lisp +++ b/koans-solved/condition-handlers.lisp @@ -37,25 +37,25 @@ (define-test type-hierarchy ;; Inheritance for condition types works the same way as for classes. (let ((condition (make-condition 'my-condition))) - (true-or-false? ____ (typep condition 'my-condition)) - (true-or-false? ____ (typep condition 'condition)) - (true-or-false? ____ (typep condition 'warning)) - (true-or-false? ____ (typep condition 'error))) + (true-or-false? t (typep condition 'my-condition)) + (true-or-false? t (typep condition 'condition)) + (true-or-false? nil (typep condition 'warning)) + (true-or-false? nil (typep condition 'error))) (let ((condition (make-condition 'my-warning))) - (true-or-false? ____ (typep condition 'my-warning)) - (true-or-false? ____ (typep condition 'warning)) - (true-or-false? ____ (typep condition 'error))) + (true-or-false? t (typep condition 'my-warning)) + (true-or-false? t (typep condition 'warning)) + (true-or-false? nil (typep condition 'error))) (let ((condition (make-condition 'my-serious-condition))) - (true-or-false? ____ (typep condition 'my-serious-condition)) - (true-or-false? ____ (typep condition 'serious-condition)) - (true-or-false? ____ (typep condition 'warning)) - (true-or-false? ____ (typep condition 'error))) + (true-or-false? t (typep condition 'my-serious-condition)) + (true-or-false? t (typep condition 'serious-condition)) + (true-or-false? nil (typep condition 'warning)) + (true-or-false? nil (typep condition 'error))) (let ((condition (make-condition 'my-error))) - (true-or-false? ____ (typep condition 'my-error)) - (true-or-false? ____ (typep condition 'my-serious-condition)) - (true-or-false? ____ (typep condition 'serious-condition)) - (true-or-false? ____ (typep condition 'warning)) - (true-or-false? ____ (typep condition 'error)))) + (true-or-false? t (typep condition 'my-error)) + (true-or-false? nil (typep condition 'my-serious-condition)) + (true-or-false? t (typep condition 'serious-condition)) + (true-or-false? nil (typep condition 'warning)) + (true-or-false? t (typep condition 'error)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -64,88 +64,104 @@ (defvar *list*) -(defun handle-my-error (condition) +(define-condition foo () ()) + +(define-condition bar (foo) ()) + +(define-condition baz (bar) ()) + +(defun handle-foo (condition) (declare (ignore condition)) - (push :my-error *list*)) + (push :foo *list*)) -(defun handle-error (condition) +(defun handle-bar (condition) (declare (ignore condition)) - (push :error *list*)) + (push :bar *list*)) -(defun handle-my-serious-condition (condition) +(defun handle-baz (condition) (declare (ignore condition)) - (push :my-serious-condition *list*)) + (push :baz *list*)) (define-test handler-bind ;; When a condition is signaled, all handlers whose type matches the ;; condition's type are allowed to execute. (let ((*list* '())) - (handler-bind ((my-error #'handle-my-error) - (error #'handle-error) - (my-serious-condition #'handle-my-serious-condition)) - (signal (make-condition 'my-error))) - (assert-equal ____ *list*))) + (handler-bind ((bar #'handle-bar) + (foo #'handle-foo) + (baz #'handle-baz)) + (signal (make-condition 'baz))) + (assert-equal '(:baz :foo :bar) *list*))) (define-test handler-order ;; The order of binding handlers matters. (let ((*list* '())) - (handler-bind ((error #'handle-error) - (my-error #'handle-my-error) - (my-serious-condition #'handle-my-serious-condition)) - (signal (make-condition 'my-error))) - (assert-equal ____ *list*))) + (handler-bind ((foo #'handle-foo) + (bar #'handle-bar) + (baz #'handle-baz)) + (signal (make-condition 'baz))) + (assert-equal '(:baz :bar :foo) *list*))) (define-test multiple-handler-binds ;; It is possible to bind handlers in steps. (let ((*list* '())) - (handler-bind ((error #'handle-error) - (my-serious-condition #'handle-my-serious-condition)) - (handler-bind ((my-error #'handle-my-error)) - (signal (make-condition 'my-error)))) - (assert-equal ____ *list*))) + (handler-bind ((foo #'handle-foo) + (baz #'handle-baz)) + (handler-bind ((bar #'handle-bar)) + (signal (make-condition 'baz)))) + (assert-equal '(:baz :foo :bar) *list*))) (define-test same-handler ;; The same handler may be bound multiple times. (let ((*list* '())) - (handler-bind ((error #'handle-error) - (error #'handle-error)) - (handler-bind ((my-error #'handle-my-error) - (error #'handle-error) - (my-error #'handle-my-error)) - (signal (make-condition 'my-error)))) - (assert-equal ____ *list*))) + (handler-bind ((foo #'handle-foo) + (foo #'handle-foo)) + (handler-bind ((bar #'handle-bar) + (foo #'handle-foo) + (bar #'handle-bar)) + (signal (make-condition 'baz)))) + (assert-equal '(:foo :foo :bar :foo :bar) *list*))) (define-test handler-types ;; A handler is not executed if it does not match the condition type. (let ((*list* '())) - (handler-bind ((error #'handle-error) - (my-error #'handle-my-error) - (my-serious-condition #'handle-my-serious-condition)) - (signal (make-condition 'my-serious-condition))) - (assert-equal ____ *list*))) + (handler-bind ((foo #'handle-foo) + (bar #'handle-bar) + (baz #'handle-baz)) + (signal (make-condition 'bar))) + (assert-equal '(:bar :foo) *list*))) (define-test handler-transfer-of-control ;; A handler may decline to handle the condition if it returns normally, ;; or it may handle the condition by transferring control elsewhere. (let ((*list* '())) (block my-block - (handler-bind ((error #'handle-error) - (error (lambda (condition) - (declare (ignore condition)) - (return-from my-block))) - (error #'handle-error)) - (signal (make-condition 'my-error)))) - (assert-equal ____ *list*))) + (handler-bind ((foo #'handle-foo) + (foo (lambda (condition) + (declare (ignore condition)) + (return-from my-block))) + (foo #'handle-foo)) + (signal (make-condition 'foo)))) + (assert-equal '(:foo) *list*))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun handle-error (condition) + (declare (ignore condition)) + (push :error *list*)) + +(define-condition my-error (error) ()) + +(defun handle-my-error (condition) + (declare (ignore condition)) + (push :my-error *list*)) + (define-test handler-case ;; HANDLER-CASE always transfers control before executing the case forms. (let ((*list* '())) (handler-case (signal (make-condition 'my-error)) (error (condition) (handle-error condition)) (my-error (condition) (handle-my-error condition))) - (assert-equal ____ *list*))) + (assert-equal '(:error) *list*))) (define-test handler-case-order ;; The order of handler cases matters. @@ -153,7 +169,7 @@ (handler-case (signal (make-condition 'my-error)) (my-error (condition) (handle-my-error condition)) (error (condition) (handle-error condition))) - (assert-equal ____ *list*))) + (assert-equal '(:my-error) *list*))) (define-test handler-case-type ;; A handler cases is not executed if it does not match the condition type. @@ -161,7 +177,7 @@ (handler-case (signal (make-condition 'error)) (my-error (condition) (handle-my-error condition)) (error (condition) (handle-error condition))) - (assert-equal ____ *list*))) + (assert-equal '(:error) *list*))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -172,8 +188,8 @@ ;; ASSERT-ERROR is a Lisp Koans macro which verifies that the correct error ;; type is signaled. (assert-equal 3 (divide 6 2)) - (assert-error 'division-by-zero (divide 6 0)) - (assert-error 'type-error (divide 6 :zero))) + (assert-error (divide 6 0) 'division-by-zero) + (assert-error (divide 6 :zero) 'type-error)) (define-test error-signaling-handler-case (flet ((try-to-divide (numerator denominator) @@ -181,9 +197,9 @@ (handler-case (divide numerator denominator) (division-by-zero () :division-by-zero) (type-error () :type-error)))) - (assert-equal ____ (try-to-divide 6 2)) - (assert-equal ____ (try-to-divide 6 0)) - (assert-equal ____ (try-to-divide 6 :zero)))) + (assert-equal 3 (try-to-divide 6 2)) + (assert-equal :division-by-zero (try-to-divide 6 0)) + (assert-equal :type-error (try-to-divide 6 :zero)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -192,18 +208,18 @@ (define-test accessors-division-by-zero (let ((condition (handler-case (divide 6 0) (division-by-zero (c) c)))) - (assert-equal ____ (arithmetic-error-operands condition)) + (assert-equal '(6 0) (arithmetic-error-operands condition)) (let ((operation (arithmetic-error-operation condition))) - (assert-equal ____ (funcall operation 12 4))))) + (assert-equal 3 (funcall operation 12 4))))) (define-test accessors-type-error (let ((condition (handler-case (divide 6 :zero) (type-error (c) c)))) - (assert-equal ____ (type-error-datum condition)) + (assert-equal :zero (type-error-datum condition)) (let ((expected-type (type-error-expected-type condition))) - (true-or-false? ____ (typep :zero expected-type)) - (true-or-false? ____ (typep 0 expected-type)) - (true-or-false? ____ (typep "zero" expected-type)) - (true-or-false? ____ (typep 0.0 expected-type))))) + (true-or-false? nil (typep :zero expected-type)) + (true-or-false? t (typep 0 expected-type)) + (true-or-false? nil (typep "zero" expected-type)) + (true-or-false? t (typep 0.0 expected-type))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -218,9 +234,9 @@ ;; The macro CHECK-TYPE signals a TYPE-ERROR if the object is not of the ;; specified type. (check-type line string) - (cond ((= 0 (search "TIMESTAMP" line)) :timestamp) - ((= 0 (search "HTTP" line)) :http) - ((= 0 (search "LOGIN" line)) :login) + (cond ((eql 0 (search "TIMESTAMP" line)) :timestamp) + ((eql 0 (search "HTTP" line)) :http) + ((eql 0 (search "LOGIN" line)) :login) ;; The function ERROR should be used for signaling serious conditions ;; and errors: if the condition is not handled, it halts program ;; execution and starts the Lisp debugger. @@ -231,12 +247,12 @@ (flet ((try-log-line-type (line) (handler-case (log-line-type line) (error (condition) condition)))) - (assert-equal ____ (try-log-line-type "TIMESTAMP 2020-05-08 16:59:39")) - (assert-equal ____ (try-log-line-type "HTTP GET / from 127.0.0.1")) - (assert-equal ____ (try-log-line-type "LOGIN administrator:hunter2")) + (assert-equal :timestamp (try-log-line-type "TIMESTAMP 2020-05-08 16:59:39")) + (assert-equal :http (try-log-line-type "HTTP GET / from 127.0.0.1")) + (assert-equal :login (try-log-line-type "LOGIN administrator:hunter2")) (let ((condition (try-log-line-type "WARNING: 95% of disk space used"))) - (assert-equal ____ (line condition)) - (assert-equal ____ (reason condition))) + (assert-equal "WARNING: 95% of disk space used" (line condition)) + (assert-equal :unknown-log-line-type (reason condition))) (let ((condition (try-log-line-type 5555))) - (assert-equal 'string (____ condition)) - (assert-equal 5555 (____ condition))))) + (assert-equal 'string (type-error-expected-type condition)) + (assert-equal 5555 (type-error-datum condition))))) diff --git a/koans-solved/dice-project.lisp b/koans-solved/dice-project.lisp index e9a4a3d6..bc26513b 100644 --- a/koans-solved/dice-project.lisp +++ b/koans-solved/dice-project.lisp @@ -18,17 +18,22 @@ (defclass dice-set () ;; Fill in the blank with a proper slot definition. - (____)) + ((values :accessor dice-values :initform '()))) -(defmethod dice-values ((object dice-set)) - ____) +;;; This method might be unnecessary, depending on how you define the slots of +;;; DICE-SET. + +;; (defmethod dice-values ((object dice-set)) +;; ____) (defmethod roll ((count integer) (object dice-set)) - ____) + (check-type count (integer 1)) + (setf (dice-values object) + (loop repeat count collect (random 6)))) (define-test make-dice-set (let ((dice (make-instance 'dice-set))) - (assert-true (type-of dice 'dice-set)))) + (assert-true (typep dice 'dice-set)))) (define-test dice-are-six-sided (let ((dice (make-instance 'dice-set))) @@ -80,12 +85,12 @@ (let* ((condition (dice-failure value)) (expected-type (type-error-expected-type condition))) (assert-true (typep condition 'type-error)) - (assert-equal value (type-error-datum)) + (assert-equal value (type-error-datum condition)) (assert-true (subtypep expected-type '(integer 1 6))) (assert-true (subtypep '(integer 1 6) expected-type))))) - (test-dice-failure 0) - (test-dice-failure "0") - (test-dice-failure :zero) - (test-dice-failure 18.0) - (test-dice-failure -7) - (test-dice-failure '(6 6 6))))) + (dice-failure 0) + (dice-failure "0") + (dice-failure :zero) + (dice-failure 18.0) + (dice-failure -7) + (dice-failure '(6 6 6))))) diff --git a/koans-solved/extra-credit.lisp b/koans-solved/extra-credit.lisp index 0e4be3f4..4e51c5dc 100644 --- a/koans-solved/extra-credit.lisp +++ b/koans-solved/extra-credit.lisp @@ -1,3 +1,17 @@ +;;; 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. + ;;; EXTRA CREDIT: ;;; ;;; Create a program that will play the Greed game. @@ -7,3 +21,7 @@ ;;; Write a PLAYER class and a GAME class to complete the project. ;;; ;;; This is a free form assignment, so approach it however you desire. + +(define-test play-greed + ;; This page intentionally left blank. + (assert-true t)) diff --git a/koans-solved/macros.lisp b/koans-solved/macros.lisp index f4f9e607..74a7c707 100644 --- a/koans-solved/macros.lisp +++ b/koans-solved/macros.lisp @@ -30,12 +30,15 @@ ;; ASSERT-EXPANDS macroexpands the first form once and checks if it is equal ;; to the second form. (assert-expands (my-and (= 0 (random 6)) (error "Bang!")) - (when (= 0 (random 6)) (error "Bang!"))) + '(when (= 0 (random 6)) (error "Bang!"))) (assert-expands (my-and (= 0 (random 6)) (= 0 (random 6)) (= 0 (random 6)) (error "Bang!")) - ____)) + '(when (= 0 (random 6)) + (when (= 0 (random 6)) + (when (= 0 (random 6)) + (error "Bang!")))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -50,9 +53,9 @@ (let ((limit 10) (result '())) (for (i 0 3) - (push i result) - (assert-equal ____ limit)) - (assert-equal ____ (nreverse result))))) + (push i result) + (assert-equal 3 limit)) + (assert-equal '(0 1 2 3) (nreverse result))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -71,9 +74,9 @@ (flet ((return-0 () (push 0 side-effects) 0) (return-3 () (push 3 side-effects) 3)) (for (i (return-0) (return-3)) - (push i result))) - (assert-equal ____ (nreverse result)) - (assert-equal ____ (nreverse side-effects))))) + (push i result))) + (assert-equal '(0 1 2 3) (nreverse result)) + (assert-equal '(0 3 3 3 3 3) (nreverse side-effects))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -95,9 +98,9 @@ (flet ((return-0 () (push 0 side-effects) 0) (return-3 () (push 3 side-effects) 3)) (for (i (return-0) (return-3)) - (push i result))) - (assert-equal ____ (nreverse result)) - (assert-equal ____ (nreverse side-effects))))) + (push i result))) + (assert-equal '(0 1 2 3) (nreverse result)) + (assert-equal '(3 0) (nreverse side-effects))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -105,12 +108,16 @@ (macrolet ((for ((var start stop) &body body) ;; Fill in the blank with a correct FOR macroexpansion that is ;; not affected by the three macro pitfalls mentioned above. - ____)) + (let ((limit (gensym "LIMIT"))) + `(do ((,var ,start (1+ ,var)) + (,limit ,stop)) + ((> ,var ,limit)) + ,@body)))) (let ((side-effects '()) (result '())) (flet ((return-0 () (push 0 side-effects) 0) (return-3 () (push 3 side-effects) 3)) (for (i (return-0) (return-3)) - (push i result))) + (push i result))) (assert-equal '(0 1 2 3) (nreverse result)) (assert-equal '(0 3) (nreverse side-effects))))) diff --git a/koans-solved/std-method-comb.lisp b/koans-solved/std-method-comb.lisp index f456d35d..6553c8be 100644 --- a/koans-solved/std-method-comb.lisp +++ b/koans-solved/std-method-comb.lisp @@ -13,7 +13,7 @@ ;;; limitations under the License. (defclass access-counter () - ((value :reader value :initform :value) + ((value :accessor value :initarg :value) (access-count :reader access-count :initform 0))) ;;; The generated reader, writer, and accessor functions are generic functions. @@ -27,23 +27,23 @@ (defmethod value :after ((object access-counter)) (incf (slot-value object 'access-count))) -(defmethod (setf value) :after ((object access-counter)) +(defmethod (setf value) :after (new-value (object access-counter)) (incf (slot-value object 'access-count))) (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)) + (assert-equal 0 (access-count counter)) + (assert-equal 42 (value counter)) + (assert-equal 1 (access-count counter)) (setf (value counter) 24) - (assert-equal ____ (access-count counter)) - (assert-equal ____ (value counter)) - (assert-equal ____ (access-count counter)) + (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 ____ (access-count counter)))) + (assert-equal 6 (access-count counter)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -61,9 +61,9 @@ (: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))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -72,21 +72,22 @@ ;; 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 :value))) + ((remaining-time :reader remaining-time :initarg :time))) (defmethod remaining-time :around ((object countdown)) - (let ((value (call-next-method))) - (if (<= 0 value) + (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 value) + (decf (slot-value object 'remaining-time)) :bang))) (define-test countdown - (let ((countdown (make-instance 'countdown :value 4))) + (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)))) @@ -124,10 +125,10 @@ (define-test multiple-methods (let ((object (make-instance 'object))) (frobnicate object) - (assert-equal ____ (counter object))) + (assert-equal 2305070 (counter object))) (let ((object (make-instance 'bigger-object))) (frobnicate object) - (assert-equal ____ (counter object)))) + (assert-equal 12345678 (counter object)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -161,10 +162,10 @@ (define-test standard-method-combination-order (let ((object (make-instance 'object))) (calculate object) - (assert-equal ____ (counter object))) + (assert-equal -1/94 (counter object))) (let ((object (make-instance 'bigger-object))) (calculate object) - (assert-equal ____ (counter object)))) + (assert-equal 197/99 (counter object)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -190,13 +191,13 @@ (define-test salary-at-company-a (let ((programmer (make-instance 'programmer))) - (assert-equal ____ (salary-at-company-a programmer))) + (assert-equal 120000 (salary-at-company-a programmer))) (let ((programmer (make-instance 'senior-programmer))) - (assert-equal ____ (salary-at-company-a programmer))) + (assert-equal 320000 (salary-at-company-a programmer))) (let ((programmer (make-instance 'full-stack-programmer))) - (assert-equal ____ (salary-at-company-a programmer))) + (assert-equal 168000 (salary-at-company-a programmer))) (let ((programmer (make-instance 'senior-full-stack-programmer))) - (assert-equal ____ (salary-at-company-a programmer)))) + (assert-equal 368000 (salary-at-company-a programmer)))) ;;; It is also possible to define custom method combinations. @@ -210,10 +211,10 @@ (define-test salary-at-company-b (let ((programmer (make-instance 'programmer))) - (assert-equal ____ (salary-at-company-b programmer))) + (assert-equal 120000 (salary-at-company-b programmer))) (let ((programmer (make-instance 'senior-programmer))) - (assert-equal ____ (salary-at-company-b programmer))) + (assert-equal 240000 (salary-at-company-b programmer))) (let ((programmer (make-instance 'full-stack-programmer))) - (assert-equal ____ (salary-at-company-b programmer))) + (assert-equal 168000 (salary-at-company-b programmer))) (let ((programmer (make-instance 'senior-full-stack-programmer))) - (assert-equal ____ (salary-at-company-b programmer)))) + (assert-equal 336000 (salary-at-company-b programmer)))) diff --git a/koans-solved/triangle-project.lisp b/koans-solved/triangle-project.lisp index 2eec4805..a5a6ea34 100644 --- a/koans-solved/triangle-project.lisp +++ b/koans-solved/triangle-project.lisp @@ -14,11 +14,20 @@ (define-condition triangle-error (error) ;; Fill in the blank with a suitable slot definition. - (____)) + ((triangle-error-sides :reader triangle-error-sides :initarg :sides))) (defun triangle (a b c) - ;;;Fill in the blank with a function that satisfies the below tests. - ____) + (check-type a (real (0))) + (check-type b (real (0))) + (check-type c (real (0))) + ;; Fill in the blank with a function that satisfies the below tests. + (let* ((min (min a b c)) + (max (max a b c)) + (mid (car (remove min (remove max (list a b c) :count 1) :count 1)))) + (cond ((<= (+ min mid) max) (error 'triangle-error :sides (list a b c))) + ((= max mid min) :equilateral) + ((= max mid) :isosceles) + (t :scalene)))) (define-test equilateral-triangles ;; Equilateral triangles have three sides of equal length, @@ -45,7 +54,7 @@ (error (condition) condition)))) (let ((condition (triangle-failure 0 0 0))) (assert-true (typep condition 'type-error)) - (assert-equal 0 (type-error-datum)) + (assert-equal 0 (type-error-datum condition)) ;; The type (REAL (0)) represents all positive numbers. (assert-true (subtypep (type-error-expected-type condition) '(real (0)))) ;; If two type specifiers are SUBTYPEP of one another, then they represent @@ -53,7 +62,7 @@ (assert-true (subtypep '(real (0)) (type-error-expected-type condition)))) (let ((condition (triangle-failure 3 4 -5))) (assert-true (typep condition 'type-error)) - (assert-equal -5 (type-error-datum)) + (assert-equal -5 (type-error-datum condition)) (assert-true (subtypep (type-error-expected-type condition) '(real (0)))) (assert-true (subtypep '(real (0)) (type-error-expected-type condition)))) (let ((condition (triangle-failure 1 1 3))) diff --git a/koans/backquote.lisp b/koans/backquote.lisp index d8e15fdb..c66deba1 100644 --- a/koans/backquote.lisp +++ b/koans/backquote.lisp @@ -53,7 +53,7 @@ (word 'dolphin)) (true-or-false? ____ (equal '(1 3 5) `(1 3 5))) (true-or-false? ____ (equal '(1 3 5) `(1 3 number))) - (assert-equal _____ `(1 3 ,number)) + (assert-equal ____ `(1 3 ,number)) (assert-equal _____ `(word ,word ,word word)))) (define-test splicing diff --git a/koans/condition-handlers.lisp b/koans/condition-handlers.lisp index 24ae56a1..7bac4bfb 100644 --- a/koans/condition-handlers.lisp +++ b/koans/condition-handlers.lisp @@ -172,8 +172,8 @@ ;; ASSERT-ERROR is a Lisp Koans macro which verifies that the correct error ;; type is signaled. (assert-equal 3 (divide 6 2)) - (assert-error 'division-by-zero (divide 6 0)) - (assert-error 'type-error (divide 6 :zero))) + (assert-error (divide 6 0) 'division-by-zero) + (assert-error (divide 6 :zero) 'type-error)) (define-test error-signaling-handler-case (flet ((try-to-divide (numerator denominator) @@ -218,9 +218,9 @@ ;; The macro CHECK-TYPE signals a TYPE-ERROR if the object is not of the ;; specified type. (check-type line string) - (cond ((= 0 (search "TIMESTAMP" line)) :timestamp) - ((= 0 (search "HTTP" line)) :http) - ((= 0 (search "LOGIN" line)) :login) + (cond ((eql 0 (search "TIMESTAMP" line)) :timestamp) + ((eql 0 (search "HTTP" line)) :http) + ((eql 0 (search "LOGIN" line)) :login) ;; The function ERROR should be used for signaling serious conditions ;; and errors: if the condition is not handled, it halts program ;; execution and starts the Lisp debugger. diff --git a/koans/dice-project.lisp b/koans/dice-project.lisp index e9a4a3d6..ea6e7b0c 100644 --- a/koans/dice-project.lisp +++ b/koans/dice-project.lisp @@ -20,6 +20,9 @@ ;; Fill in the blank with a proper slot definition. (____)) +;;; This method might be unnecessary, depending on how you define the slots of +;;; DICE-SET. + (defmethod dice-values ((object dice-set)) ____) @@ -28,7 +31,7 @@ (define-test make-dice-set (let ((dice (make-instance 'dice-set))) - (assert-true (type-of dice 'dice-set)))) + (assert-true (typep dice 'dice-set)))) (define-test dice-are-six-sided (let ((dice (make-instance 'dice-set))) @@ -80,12 +83,12 @@ (let* ((condition (dice-failure value)) (expected-type (type-error-expected-type condition))) (assert-true (typep condition 'type-error)) - (assert-equal value (type-error-datum)) + (assert-equal value (type-error-datum condition)) (assert-true (subtypep expected-type '(integer 1 6))) (assert-true (subtypep '(integer 1 6) expected-type))))) - (test-dice-failure 0) - (test-dice-failure "0") - (test-dice-failure :zero) - (test-dice-failure 18.0) - (test-dice-failure -7) - (test-dice-failure '(6 6 6))))) + (dice-failure 0) + (dice-failure "0") + (dice-failure :zero) + (dice-failure 18.0) + (dice-failure -7) + (dice-failure '(6 6 6))))) diff --git a/koans/extra-credit.lisp b/koans/extra-credit.lisp index 0e4be3f4..2bd62be9 100644 --- a/koans/extra-credit.lisp +++ b/koans/extra-credit.lisp @@ -1,3 +1,17 @@ +;;; 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. + ;;; EXTRA CREDIT: ;;; ;;; Create a program that will play the Greed game. @@ -7,3 +21,6 @@ ;;; Write a PLAYER class and a GAME class to complete the project. ;;; ;;; This is a free form assignment, so approach it however you desire. + +(define-test play-greed + (assert-true ____)) diff --git a/koans/macros.lisp b/koans/macros.lisp index f4f9e607..85415138 100644 --- a/koans/macros.lisp +++ b/koans/macros.lisp @@ -30,7 +30,7 @@ ;; ASSERT-EXPANDS macroexpands the first form once and checks if it is equal ;; to the second form. (assert-expands (my-and (= 0 (random 6)) (error "Bang!")) - (when (= 0 (random 6)) (error "Bang!"))) + '(when (= 0 (random 6)) (error "Bang!"))) (assert-expands (my-and (= 0 (random 6)) (= 0 (random 6)) (= 0 (random 6)) @@ -50,8 +50,8 @@ (let ((limit 10) (result '())) (for (i 0 3) - (push i result) - (assert-equal ____ limit)) + (push i result) + (assert-equal ____ limit)) (assert-equal ____ (nreverse result))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/koans/std-method-comb.lisp b/koans/std-method-comb.lisp index f456d35d..661c51e5 100644 --- a/koans/std-method-comb.lisp +++ b/koans/std-method-comb.lisp @@ -13,7 +13,7 @@ ;;; limitations under the License. (defclass access-counter () - ((value :reader value :initform :value) + ((value :accessor value :initarg :value) (access-count :reader access-count :initform 0))) ;;; The generated reader, writer, and accessor functions are generic functions. @@ -27,7 +27,7 @@ (defmethod value :after ((object access-counter)) (incf (slot-value object 'access-count))) -(defmethod (setf value) :after ((object access-counter)) +(defmethod (setf value) :after (new-value (object access-counter)) (incf (slot-value object 'access-count))) (define-test defmethod-after @@ -72,23 +72,24 @@ ;; 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 :value))) + ((remaining-time :reader remaining-time :initarg :time))) (defmethod remaining-time :around ((object countdown)) - (let ((value (call-next-method))) - (if (<= 0 value) + (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 value) + (decf (slot-value object 'remaining-time)) :bang))) (define-test countdown - (let ((countdown (make-instance 'countdown :value 4))) + (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 :bang (remaining-time countdown)) - (assert-equal :bang (remaining-time countdown)))) + (assert-equal ____ (remaining-time countdown)) + (assert-equal ____ (remaining-time countdown)) + (assert-equal ____ (remaining-time countdown)) + (assert-equal ____ (remaining-time countdown)) + (assert-equal ____ (remaining-time countdown)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/koans/triangle-project.lisp b/koans/triangle-project.lisp index 2eec4805..275f0340 100644 --- a/koans/triangle-project.lisp +++ b/koans/triangle-project.lisp @@ -17,7 +17,7 @@ (____)) (defun triangle (a b c) - ;;;Fill in the blank with a function that satisfies the below tests. + ;; Fill in the blank with a function that satisfies the below tests. ____) (define-test equilateral-triangles @@ -45,7 +45,7 @@ (error (condition) condition)))) (let ((condition (triangle-failure 0 0 0))) (assert-true (typep condition 'type-error)) - (assert-equal 0 (type-error-datum)) + (assert-equal 0 (type-error-datum condition)) ;; The type (REAL (0)) represents all positive numbers. (assert-true (subtypep (type-error-expected-type condition) '(real (0)))) ;; If two type specifiers are SUBTYPEP of one another, then they represent @@ -53,7 +53,7 @@ (assert-true (subtypep '(real (0)) (type-error-expected-type condition)))) (let ((condition (triangle-failure 3 4 -5))) (assert-true (typep condition 'type-error)) - (assert-equal -5 (type-error-datum)) + (assert-equal -5 (type-error-datum condition)) (assert-true (subtypep (type-error-expected-type condition) '(real (0)))) (assert-true (subtypep '(real (0)) (type-error-expected-type condition)))) (let ((condition (triangle-failure 1 1 3))) diff --git a/lisp-koans.lisp b/lisp-koans.lisp index 58224003..39d15271 100644 --- a/lisp-koans.lisp +++ b/lisp-koans.lisp @@ -102,13 +102,14 @@ (koan-status-message koan-status) dirname filename koan-name koan-status))) (defun print-completion-message () - (format t "********************************************************* + (format t " +********************************************************* That was the last one, well done! ENLIGHTENMENT IS YOURS! ********************************************************* If you demand greater challenge, take a look at extra-credit.lisp Or, let the student become the teacher: -Write and submit your own improvements to https://github.com/google/lisp-koans! +Write and submit your own improvements to https://github.com/google/lisp-koans!~% ")) (defun print-progress-message () diff --git a/test-framework.lisp b/test-framework.lisp index 2540a6ea..7952132a 100644 --- a/test-framework.lisp +++ b/test-framework.lisp @@ -142,11 +142,13 @@ (defmacro assert-error (form condition) "Assert whether form signals condition." - `(expand-assert :error ,form (handler-case ,form (error (e) e)) ,condition)) + (let ((e (gensym "E"))) + `(expand-assert :error ,form (handler-case ,form (error (,e) (type-of ,e))) + ,condition))) (defmacro assert-expands (form expected) "Assert whether form expands to expansion." - `(expand-assert :macro ',form (macroexpand-1 ',form) ',expected)) + `(expand-assert :macro ',form (macroexpand-1 ',form) ,expected)) (defmacro assert-false (form) "Assert whether the form is false." From 7e3d67c9c59ecb74da7c48509fd239af41bc9379 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Sat, 9 May 2020 11:04:40 +0200 Subject: [PATCH 104/133] Obviously another fix was necessary --- koans-solved/dice-project.lisp | 19 +++++++++---------- koans/dice-project.lisp | 17 ++++++++--------- 2 files changed, 17 insertions(+), 19 deletions(-) diff --git a/koans-solved/dice-project.lisp b/koans-solved/dice-project.lisp index bc26513b..e73ef66f 100644 --- a/koans-solved/dice-project.lisp +++ b/koans-solved/dice-project.lisp @@ -26,10 +26,10 @@ ;; (defmethod dice-values ((object dice-set)) ;; ____) -(defmethod roll ((count integer) (object dice-set)) +(defmethod roll (count (object dice-set)) (check-type count (integer 1)) (setf (dice-values object) - (loop repeat count collect (random 6)))) + (loop repeat count collect (1+ (random 6))))) (define-test make-dice-set (let ((dice (make-instance 'dice-set))) @@ -78,7 +78,7 @@ (define-test junk-as-dice-count (let ((dice (make-instance 'dice-set))) (labels ((dice-failure (count) - (handler-case (progn (roll-dice count dice) + (handler-case (progn (roll count dice) (error "Test failure")) (error (condition) condition))) (test-dice-failure (value) @@ -86,11 +86,10 @@ (expected-type (type-error-expected-type condition))) (assert-true (typep condition 'type-error)) (assert-equal value (type-error-datum condition)) - (assert-true (subtypep expected-type '(integer 1 6))) (assert-true (subtypep '(integer 1 6) expected-type))))) - (dice-failure 0) - (dice-failure "0") - (dice-failure :zero) - (dice-failure 18.0) - (dice-failure -7) - (dice-failure '(6 6 6))))) + (test-dice-failure 0) + (test-dice-failure "0") + (test-dice-failure :zero) + (test-dice-failure 18.0) + (test-dice-failure -7) + (test-dice-failure '(6 6 6))))) diff --git a/koans/dice-project.lisp b/koans/dice-project.lisp index ea6e7b0c..d48f72b9 100644 --- a/koans/dice-project.lisp +++ b/koans/dice-project.lisp @@ -26,7 +26,7 @@ (defmethod dice-values ((object dice-set)) ____) -(defmethod roll ((count integer) (object dice-set)) +(defmethod roll (count (object dice-set)) ____) (define-test make-dice-set @@ -76,7 +76,7 @@ (define-test junk-as-dice-count (let ((dice (make-instance 'dice-set))) (labels ((dice-failure (count) - (handler-case (progn (roll-dice count dice) + (handler-case (progn (roll count dice) (error "Test failure")) (error (condition) condition))) (test-dice-failure (value) @@ -84,11 +84,10 @@ (expected-type (type-error-expected-type condition))) (assert-true (typep condition 'type-error)) (assert-equal value (type-error-datum condition)) - (assert-true (subtypep expected-type '(integer 1 6))) (assert-true (subtypep '(integer 1 6) expected-type))))) - (dice-failure 0) - (dice-failure "0") - (dice-failure :zero) - (dice-failure 18.0) - (dice-failure -7) - (dice-failure '(6 6 6))))) + (test-dice-failure 0) + (test-dice-failure "0") + (test-dice-failure :zero) + (test-dice-failure 18.0) + (test-dice-failure -7) + (test-dice-failure '(6 6 6))))) From c7ca15c1d19ecd0351d5730c4beccc6a10e17c89 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Sat, 9 May 2020 11:50:24 +0200 Subject: [PATCH 105/133] Fix framework, add reader conditionals for ABCL/ECL/CLISP --- koans-solved/condition-handlers.lisp | 7 +++++++ koans-solved/hash-tables.lisp | 3 +++ koans/condition-handlers.lisp | 7 +++++++ koans/hash-tables.lisp | 3 +++ test-framework.lisp | 2 +- 5 files changed, 21 insertions(+), 1 deletion(-) diff --git a/koans-solved/condition-handlers.lisp b/koans-solved/condition-handlers.lisp index 5ccb085d..bad1c2a3 100644 --- a/koans-solved/condition-handlers.lisp +++ b/koans-solved/condition-handlers.lisp @@ -208,8 +208,15 @@ (define-test accessors-division-by-zero (let ((condition (handler-case (divide 6 0) (division-by-zero (c) c)))) + ;; Disabled on CLISP and ABCL due to conformance bugs. + ;; See https://gitlab.com/gnu-clisp/clisp/-/issues/22 + ;; See https://github.com/armedbear/abcl/issues/177 + #-(or clisp abcl) (assert-equal '(6 0) (arithmetic-error-operands condition)) (let ((operation (arithmetic-error-operation condition))) + ;; Disabled on ABCL due to a conformance bug. + ;; See https://github.com/armedbear/abcl/issues/177 + #-abcl (assert-equal 3 (funcall operation 12 4))))) (define-test accessors-type-error diff --git a/koans-solved/hash-tables.lisp b/koans-solved/hash-tables.lisp index c0290b1e..febaaec8 100644 --- a/koans-solved/hash-tables.lisp +++ b/koans-solved/hash-tables.lisp @@ -81,6 +81,9 @@ (true-or-false? t (equalp hash-table-1 hash-table-2)))) (define-test i-will-make-it-equalp + ;; Disabled on ECL due to a conformance bug. + ;; See https://gitlab.com/embeddable-common-lisp/ecl/-/issues/587 + #-ecl (let ((hash-table-1 (make-hash-table :test #'equal)) (hash-table-2 (make-hash-table :test #'equal))) (setf (gethash "one" hash-table-1) "uno" diff --git a/koans/condition-handlers.lisp b/koans/condition-handlers.lisp index 7bac4bfb..3caa10c5 100644 --- a/koans/condition-handlers.lisp +++ b/koans/condition-handlers.lisp @@ -192,8 +192,15 @@ (define-test accessors-division-by-zero (let ((condition (handler-case (divide 6 0) (division-by-zero (c) c)))) + ;; Disabled on CLISP and ABCL due to conformance bugs. + ;; See https://gitlab.com/gnu-clisp/clisp/-/issues/22 + ;; See https://github.com/armedbear/abcl/issues/177 + #-(or clisp abcl) (assert-equal ____ (arithmetic-error-operands condition)) (let ((operation (arithmetic-error-operation condition))) + ;; Disabled on ABCL due to a conformance bug. + ;; See https://github.com/armedbear/abcl/issues/177 + #-abcl (assert-equal ____ (funcall operation 12 4))))) (define-test accessors-type-error diff --git a/koans/hash-tables.lisp b/koans/hash-tables.lisp index d5a7b89d..35ffb5e4 100644 --- a/koans/hash-tables.lisp +++ b/koans/hash-tables.lisp @@ -81,6 +81,9 @@ (true-or-false? ____ (equalp hash-table-1 hash-table-2)))) (define-test i-will-make-it-equalp + ;; Disabled on ECL due to a conformance bug. + ;; See https://gitlab.com/embeddable-common-lisp/ecl/-/issues/587 + #-ecl (let ((hash-table-1 (make-hash-table :test #'equal)) (hash-table-2 (make-hash-table :test #'equal))) (setf (gethash "one" hash-table-1) "uno" diff --git a/test-framework.lisp b/test-framework.lisp index 7952132a..4be44d86 100644 --- a/test-framework.lisp +++ b/test-framework.lisp @@ -91,7 +91,7 @@ (defun test-passed-p (type expected actual test) (ecase type - (:error (or (eql (car actual) (car expected)) (typep (car actual) (car expected)))) + (:error (or (eql (car actual) (car expected)) (subtypep (car actual) (car expected)))) (:equal (and (>= (length expected) (length actual)) (every test expected actual))) (:macro (equal (car actual) (car expected))) (:result (eql (not (car actual)) (not (car expected)))))) From 42fc20a8ef711dbb824bd57898a328508e74b0c2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Sat, 9 May 2020 12:10:12 +0200 Subject: [PATCH 106/133] Use lists instead of hash tables for test storage --- test-framework.lisp | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/test-framework.lisp b/test-framework.lisp index 4be44d86..a66af06c 100644 --- a/test-framework.lisp +++ b/test-framework.lisp @@ -66,13 +66,19 @@ (defparameter *test-db* (make-hash-table :test #'eq)) (defun package-table (package) - (or (gethash (find-package package) *test-db*) - (setf (gethash package *test-db*) (make-hash-table)))) + (multiple-value-bind (value foundp) (gethash (find-package package) *test-db*) + (if foundp + value + (setf (gethash package *test-db*) '())))) + +(defun (setf package-table) (new-value package) + (setf (gethash (find-package package) *test-db*) new-value)) (defmacro define-test (name &body body) "Store the test in the test database." `(progn - (setf (gethash ',name (package-table *package*)) ',body) + (pushnew (list ',name ',body) (package-table *package*) + :test (lambda (x y) (eq (car x) (car y)))) ',name)) ;;; Test statistics @@ -80,12 +86,12 @@ (defun test-count (&optional (package *package*)) "Returns the number of tests for a package." (let ((table (package-table package))) - (if table (hash-table-count table) 0))) + (length table))) (defun test-total-count () "Returns the total number of tests." (loop for table being the hash-value of *test-db* - sum (hash-table-count table))) + sum (length table))) ;;; Test passed predicate. @@ -169,8 +175,7 @@ (defun run-koans (package) "Run all koans for a given package." (loop with results = nil - for test-name being each hash-key in (package-table package) - using (hash-value unit-test) + for (test-name unit-test) in (reverse (package-table package)) for koan-result = (run-koan unit-test) do (push (list test-name koan-result) results) while (every (lambda (x) (eq x :pass)) koan-result) From f592e232b9eb533199e04c3e3ecd250f8997b424 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Sat, 9 May 2020 12:28:10 +0200 Subject: [PATCH 107/133] Two more bit array things --- koans-solved/arrays.lisp | 2 ++ koans/arrays.lisp | 2 ++ 2 files changed, 4 insertions(+) diff --git a/koans-solved/arrays.lisp b/koans-solved/arrays.lisp index 57d1c256..2aaf886f 100644 --- a/koans-solved/arrays.lisp +++ b/koans-solved/arrays.lisp @@ -67,4 +67,6 @@ (dotimes (i (* 2 2 2 2)) (setf (row-major-aref my-array i) i)) (assert-equal 0 (aref my-array 0 0 0 0)) + (assert-equal 2 (aref my-array 0 0 1 0)) + (assert-equal 4 (aref my-array 0 1 0 0)) (assert-equal 15 (aref my-array 1 1 1 1)))) diff --git a/koans/arrays.lisp b/koans/arrays.lisp index 788abeee..3b1c6426 100644 --- a/koans/arrays.lisp +++ b/koans/arrays.lisp @@ -67,4 +67,6 @@ (dotimes (i (* 2 2 2 2)) (setf (row-major-aref my-array i) i)) (assert-equal ____ (aref my-array 0 0 0 0)) + (assert-equal ____ (aref my-array 0 0 1 0)) + (assert-equal ____ (aref my-array 0 1 0 0)) (assert-equal ____ (aref my-array 1 1 1 1)))) From e52cf3a996ffd861eb04e0b5f8a33da921ca4f13 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Sat, 9 May 2020 12:29:36 +0200 Subject: [PATCH 108/133] Fix CLISP style warnings --- koans-solved/loops.lisp | 2 +- koans/loops.lisp | 2 +- test-framework.lisp | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/koans-solved/loops.lisp b/koans-solved/loops.lisp index 9b55c903..7a30e6be 100644 --- a/koans-solved/loops.lisp +++ b/koans-solved/loops.lisp @@ -92,7 +92,7 @@ (gethash "The Wizard Of Oz" book-heroes) "Dorothy" (gethash "The Great Gatsby" book-heroes) "James Gatz") ;; LOOP can iterate over hash tables. - (let ((pairs-in-table (loop for key being the hash-key of book-heroes + (let ((pairs-in-table (loop for key being the hash-keys of book-heroes using (hash-value value) collect (list key value)))) (assert-equal 4 (length pairs-in-table)) diff --git a/koans/loops.lisp b/koans/loops.lisp index 00fb7b5f..a6dd4ac4 100644 --- a/koans/loops.lisp +++ b/koans/loops.lisp @@ -92,7 +92,7 @@ (gethash "The Wizard Of Oz" book-heroes) "Dorothy" (gethash "The Great Gatsby" book-heroes) "James Gatz") ;; LOOP can iterate over hash tables. - (let ((pairs-in-table (loop for key being the hash-key of book-heroes + (let ((pairs-in-table (loop for key being the hash-keys of book-heroes using (hash-value value) collect (list key value)))) (assert-equal ____ (length pairs-in-table)) diff --git a/test-framework.lisp b/test-framework.lisp index a66af06c..78cbc90d 100644 --- a/test-framework.lisp +++ b/test-framework.lisp @@ -90,7 +90,7 @@ (defun test-total-count () "Returns the total number of tests." - (loop for table being the hash-value of *test-db* + (loop for table being the hash-values of *test-db* sum (length table))) ;;; Test passed predicate. From 30d6b7980cdf7c892219bc1c3e5518d89e5545c2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Sat, 9 May 2020 14:00:35 +0200 Subject: [PATCH 109/133] Fix a typo --- koans/std-method-comb.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/koans/std-method-comb.lisp b/koans/std-method-comb.lisp index 661c51e5..d8b4980a 100644 --- a/koans/std-method-comb.lisp +++ b/koans/std-method-comb.lisp @@ -48,7 +48,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; In addition to :BEFORE and :AFTER methods is also possible to write :AROUND -;;; methods, whose code executes around the primary method. In such context, it +;;; methods, whose code executes around the primary methods. In such context, it ;;; is possible to call the primary method via CALL-NEXT-METHOD. ;;; In the standard method combination, the :AFTER method, if one exists, is ;;; executed first, and it may choose whether and how to call next methods. From 1df27b91e1a03e6b70a3fe993f34e3da50fc9911 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Sat, 9 May 2020 15:04:55 +0200 Subject: [PATCH 110/133] Fix :AROUND method description --- koans-solved/std-method-comb.lisp | 4 ++-- koans/std-method-comb.lisp | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/koans-solved/std-method-comb.lisp b/koans-solved/std-method-comb.lisp index 6553c8be..2dbd6ab3 100644 --- a/koans-solved/std-method-comb.lisp +++ b/koans-solved/std-method-comb.lisp @@ -48,9 +48,9 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; In addition to :BEFORE and :AFTER methods is also possible to write :AROUND -;;; methods, whose code executes around the primary method. In such context, it +;;; 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 :AFTER method, if one exists, is +;;; 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 () diff --git a/koans/std-method-comb.lisp b/koans/std-method-comb.lisp index d8b4980a..c05862ce 100644 --- a/koans/std-method-comb.lisp +++ b/koans/std-method-comb.lisp @@ -48,9 +48,9 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; In addition to :BEFORE and :AFTER methods is also possible to write :AROUND -;;; methods, whose code executes around the primary methods. In such context, it +;;; 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 :AFTER method, if one exists, is +;;; 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 () From 225b75a85ecda1697487fe8de7f41845fb4c8038 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Sat, 9 May 2020 19:16:57 +0200 Subject: [PATCH 111/133] Change package names to avoid com.google --- contemplate.lisp | 2 +- lisp-koans.lisp | 10 +++++----- test-framework.lisp | 4 ++-- test.lisp | 2 +- 4 files changed, 9 insertions(+), 9 deletions(-) diff --git a/contemplate.lisp b/contemplate.lisp index 605675a5..c9ec921a 100644 --- a/contemplate.lisp +++ b/contemplate.lisp @@ -26,4 +26,4 @@ #+quicklisp (ql:quickload :bordeaux-threads) -(com.google.lisp-koans:main) +(lisp-koans.core:main) diff --git a/lisp-koans.lisp b/lisp-koans.lisp index 39d15271..f7c53668 100644 --- a/lisp-koans.lisp +++ b/lisp-koans.lisp @@ -12,12 +12,12 @@ ;;; See the License for the specific language governing permissions and ;;; limitations under the License. -(defpackage #:com.google.lisp-koans +(defpackage #:lisp-koans.core (:use #:common-lisp - #:com.google.lisp-koans.test) + #:lisp-koans.test) (:export #:main)) -(in-package :com.google.lisp-koans) +(in-package :lisp-koans.core) (defvar *all-koan-groups* (with-open-file (in #p".koans") @@ -28,7 +28,7 @@ ;;; Functions for loading koans (defun package-name-from-group-name (group-name) - (format nil "COM.GOOGLE.LISP-KOANS.KOANS.~A" group-name)) + (format nil "LISP-KOANS.KOANS.~A" group-name)) (defun load-koan-group-named (dirname koan-group-name) (let* ((koan-name (string-downcase (string koan-group-name))) @@ -36,7 +36,7 @@ (koan-package-name (package-name-from-group-name koan-group-name))) (unless (find-package koan-package-name) (make-package koan-package-name - :use '(#:common-lisp #:com.google.lisp-koans.test))) + :use '(#:common-lisp #:lisp-koans.test))) (let ((*package* (find-package koan-package-name))) (load (concatenate 'string dirname "/" koan-file-name))))) diff --git a/test-framework.lisp b/test-framework.lisp index 78cbc90d..8ef1904f 100644 --- a/test-framework.lisp +++ b/test-framework.lisp @@ -44,7 +44,7 @@ ;;; 4) Rename the system to not collide with the original LISP-UNIT. ;;; Packages -(defpackage #:com.google.lisp-koans.test +(defpackage #:lisp-koans.test (:use #:common-lisp) ;; Assertions (:export #:assert-eq #:assert-eql #:assert-equal #:assert-equalp #:true-or-false? @@ -54,7 +54,7 @@ ;; Test blank (:export #:____)) -(in-package #:com.google.lisp-koans.test) +(in-package #:lisp-koans.test) ;; The self-evaluating test blank allows many Lisp forms in the koans to compile ;; without errors. diff --git a/test.lisp b/test.lisp index dbca2fb2..9441a1dd 100644 --- a/test.lisp +++ b/test.lisp @@ -26,4 +26,4 @@ #+quicklisp (ql:quickload :bordeaux-threads) -(com.google.lisp-koans:main "koans-solved") +(lisp-koans.core:main "koans-solved") From fb9d779a8045b252de97afe91b8c2c8492cfb0de Mon Sep 17 00:00:00 2001 From: Jon Godbout Date: Sun, 10 May 2020 12:02:22 -0400 Subject: [PATCH 112/133] Add MIT license to the license file --- LICENSE | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/LICENSE b/LICENSE index f433b1a5..bf2f8331 100644 --- a/LICENSE +++ b/LICENSE @@ -175,3 +175,28 @@ of your accepting any such warranty or additional liability. END OF TERMS AND CONDITIONS + +------------------------------------------------ +For test-framework: + +The MIT License + +Copyright (c) 2004-2005 Christopher K. Riesbeck + + Permission is hereby granted, free of charge, to any person obtaining + a copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included + in all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS + OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR + OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, + ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR + OTHER DEALINGS IN THE SOFTWARE. From 2a62aff67b702526bb5ee40d9ce331af3363fb15 Mon Sep 17 00:00:00 2001 From: spainisnotequal Date: Fri, 15 May 2020 16:25:53 +0200 Subject: [PATCH 113/133] Fix OR description --- koans/control-statements.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/koans/control-statements.lisp b/koans/control-statements.lisp index 04929b67..13ba43b4 100644 --- a/koans/control-statements.lisp +++ b/koans/control-statements.lisp @@ -57,7 +57,7 @@ x))) (define-test or-short-circuit - ;; AND only evaluates forms until one evaluates to non-NIL. + ;; OR only evaluates forms until one evaluates to non-NIL. (assert-equal ____ (let ((x 0)) (or From 763c31e79580e440a5f9d38fcf6b5db35873d03f Mon Sep 17 00:00:00 2001 From: spainisnotequal Date: Fri, 15 May 2020 19:13:47 +0200 Subject: [PATCH 114/133] Fix missing "#" in a list of characters --- koans/loops.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/koans/loops.lisp b/koans/loops.lisp index a6dd4ac4..02d7e8b3 100644 --- a/koans/loops.lisp +++ b/koans/loops.lisp @@ -17,7 +17,7 @@ (define-test loop-collect ;; LOOP can collect the results in various ways. - (let* ((result-1 (loop for letter in '(#\a \b #\c #\d) collect letter)) + (let* ((result-1 (loop for letter in '(#\a #\b #\c #\d) collect letter)) (result-2 (loop for number in '(1 2 3 4 5) sum number)) (result-3 (loop for list in '((foo) (bar) (baz)) append list))) (assert-equal ____ result-1) From 811fddaa5950fa9d1930176b562b8c369e33ffc1 Mon Sep 17 00:00:00 2001 From: spainisnotequal Date: Sun, 17 May 2020 12:01:25 +0200 Subject: [PATCH 115/133] Fix the missing "#" in a list of characters in the solutions as well --- koans-solved/loops.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/koans-solved/loops.lisp b/koans-solved/loops.lisp index 7a30e6be..0d7c2b73 100644 --- a/koans-solved/loops.lisp +++ b/koans-solved/loops.lisp @@ -17,7 +17,7 @@ (define-test loop-collect ;; LOOP can collect the results in various ways. - (let* ((result-1 (loop for letter in '(#\a \b #\c #\d) collect letter)) + (let* ((result-1 (loop for letter in '(#\a #\b #\c #\d) collect letter)) (result-2 (loop for number in '(1 2 3 4 5) sum number)) (result-3 (loop for list in '((foo) (bar) (baz)) append list))) (assert-equal '(#\a \b #\c #\d) result-1) From e09baace1ca10b03d57ed3329852ee210a4b79f2 Mon Sep 17 00:00:00 2001 From: spainisnotequal Date: Sun, 17 May 2020 12:04:38 +0200 Subject: [PATCH 116/133] Fix OR description (same fix as in PR #114) in the solutions as well --- koans-solved/control-statements.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/koans-solved/control-statements.lisp b/koans-solved/control-statements.lisp index 796ca86b..48b73a1a 100644 --- a/koans-solved/control-statements.lisp +++ b/koans-solved/control-statements.lisp @@ -57,7 +57,7 @@ x))) (define-test or-short-circuit - ;; AND only evaluates forms until one evaluates to non-NIL. + ;; OR only evaluates forms until one evaluates to non-NIL. (assert-equal 2 (let ((x 0)) (or From 3d235f6a1ddc802b0275173966b84e221b5d28ec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Wed, 20 May 2020 21:31:21 +0200 Subject: [PATCH 117/133] Fix #116 --- koans/condition-handlers.lisp | 84 +++++++++++++++++++++-------------- 1 file changed, 50 insertions(+), 34 deletions(-) diff --git a/koans/condition-handlers.lisp b/koans/condition-handlers.lisp index 3caa10c5..80b0a194 100644 --- a/koans/condition-handlers.lisp +++ b/koans/condition-handlers.lisp @@ -64,64 +64,70 @@ (defvar *list*) -(defun handle-my-error (condition) +(define-condition foo () ()) + +(define-condition bar (foo) ()) + +(define-condition baz (bar) ()) + +(defun handle-foo (condition) (declare (ignore condition)) - (push :my-error *list*)) + (push :foo *list*)) -(defun handle-error (condition) +(defun handle-bar (condition) (declare (ignore condition)) - (push :error *list*)) + (push :bar *list*)) -(defun handle-my-serious-condition (condition) +(defun handle-baz (condition) (declare (ignore condition)) - (push :my-serious-condition *list*)) + (push :baz *list*)) (define-test handler-bind ;; When a condition is signaled, all handlers whose type matches the ;; condition's type are allowed to execute. (let ((*list* '())) - (handler-bind ((my-error #'handle-my-error) - (error #'handle-error) - (my-serious-condition #'handle-my-serious-condition)) - (signal (make-condition 'my-error))) + (handler-bind ((bar #'handle-bar) + (foo #'handle-foo) + (baz #'handle-baz)) + (signal (make-condition 'baz))) (assert-equal ____ *list*))) (define-test handler-order ;; The order of binding handlers matters. (let ((*list* '())) - (handler-bind ((error #'handle-error) - (my-error #'handle-my-error) - (my-serious-condition #'handle-my-serious-condition)) - (signal (make-condition 'my-error))) + (handler-bind ((foo #'handle-foo) + (bar #'handle-bar) + (baz #'handle-baz)) + (signal (make-condition 'baz))) (assert-equal ____ *list*))) (define-test multiple-handler-binds ;; It is possible to bind handlers in steps. (let ((*list* '())) - (handler-bind ((error #'handle-error) - (my-serious-condition #'handle-my-serious-condition)) - (handler-bind ((my-error #'handle-my-error)) - (signal (make-condition 'my-error)))) + (handler-bind ((foo #'handle-foo) + (baz #'handle-baz)) + (handler-bind ((bar #'handle-bar)) + (signal (make-condition 'baz)))) (assert-equal ____ *list*))) (define-test same-handler ;; The same handler may be bound multiple times. (let ((*list* '())) - (handler-bind ((error #'handle-error) - (error #'handle-error)) - (handler-bind ((my-error #'handle-my-error) - (error #'handle-error) - (my-error #'handle-my-error)) - (signal (make-condition 'my-error)))) + (handler-bind ((foo #'handle-foo) + (foo #'handle-foo)) + (handler-bind ((bar #'handle-bar) + (foo #'handle-foo) + (bar #'handle-bar)) + (signal (make-condition 'baz)))) (assert-equal ____ *list*))) (define-test handler-types ;; A handler is not executed if it does not match the condition type. (let ((*list* '())) - (handler-bind ((error #'handle-error) - (my-error #'handle-my-error) - (my-serious-condition #'handle-my-serious-condition)) - (signal (make-condition 'my-serious-condition))) + (handler-bind ((foo #'handle-foo) + (bar #'handle-bar) + (baz #'handle-baz)) + (signal (make-condition 'bar))) (assert-equal ____ *list*))) (define-test handler-transfer-of-control @@ -129,16 +135,26 @@ ;; or it may handle the condition by transferring control elsewhere. (let ((*list* '())) (block my-block - (handler-bind ((error #'handle-error) - (error (lambda (condition) - (declare (ignore condition)) - (return-from my-block))) - (error #'handle-error)) - (signal (make-condition 'my-error)))) + (handler-bind ((foo #'handle-foo) + (foo (lambda (condition) + (declare (ignore condition)) + (return-from my-block))) + (foo #'handle-foo)) + (signal (make-condition 'foo)))) (assert-equal ____ *list*))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun handle-error (condition) + (declare (ignore condition)) + (push :error *list*)) + +(define-condition my-error (error) ()) + +(defun handle-my-error (condition) + (declare (ignore condition)) + (push :my-error *list*)) + (define-test handler-case ;; HANDLER-CASE always transfers control before executing the case forms. (let ((*list* '())) From 225e1eb4e84ce419e3018dbad83876ebb6ad251b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Thu, 21 May 2020 19:12:04 +0200 Subject: [PATCH 118/133] Better names in condition-handlers.lisp --- koans-solved/condition-handlers.lisp | 100 +++++++++++++++------------ koans/condition-handlers.lisp | 74 ++++++++++---------- 2 files changed, 94 insertions(+), 80 deletions(-) diff --git a/koans-solved/condition-handlers.lisp b/koans-solved/condition-handlers.lisp index bad1c2a3..7d7bee16 100644 --- a/koans-solved/condition-handlers.lisp +++ b/koans-solved/condition-handlers.lisp @@ -64,84 +64,98 @@ (defvar *list*) -(define-condition foo () ()) +(define-condition silly-condition () ()) -(define-condition bar (foo) ()) +(define-condition very-silly-condition (silly-condition) ()) -(define-condition baz (bar) ()) +(define-condition most-silly-condition (very-silly-condition) ()) -(defun handle-foo (condition) +(defun handle-silly-condition (condition) (declare (ignore condition)) - (push :foo *list*)) + (push :silly-condition *list*)) -(defun handle-bar (condition) +(defun handle-very-silly-condition (condition) (declare (ignore condition)) - (push :bar *list*)) + (push :very-silly-condition *list*)) -(defun handle-baz (condition) +(defun handle-most-silly-condition (condition) (declare (ignore condition)) - (push :baz *list*)) + (push :most-silly-condition *list*)) (define-test handler-bind ;; When a condition is signaled, all handlers whose type matches the ;; condition's type are allowed to execute. (let ((*list* '())) - (handler-bind ((bar #'handle-bar) - (foo #'handle-foo) - (baz #'handle-baz)) - (signal (make-condition 'baz))) - (assert-equal '(:baz :foo :bar) *list*))) + (handler-bind ((very-silly-condition #'handle-very-silly-condition) + (silly-condition #'handle-silly-condition) + (most-silly-condition #'handle-most-silly-condition)) + (signal (make-condition 'most-silly-condition))) + (assert-equal '(:most-silly-condition + :silly-condition + :very-silly-condition) + *list*))) (define-test handler-order ;; The order of binding handlers matters. (let ((*list* '())) - (handler-bind ((foo #'handle-foo) - (bar #'handle-bar) - (baz #'handle-baz)) - (signal (make-condition 'baz))) - (assert-equal '(:baz :bar :foo) *list*))) + (handler-bind ((silly-condition #'handle-silly-condition) + (very-silly-condition #'handle-very-silly-condition) + (most-silly-condition #'handle-most-silly-condition)) + (signal (make-condition 'most-silly-condition))) + (assert-equal '(:most-silly-condition + :very-silly-condition + :silly-condition) + *list*))) (define-test multiple-handler-binds ;; It is possible to bind handlers in steps. (let ((*list* '())) - (handler-bind ((foo #'handle-foo) - (baz #'handle-baz)) - (handler-bind ((bar #'handle-bar)) - (signal (make-condition 'baz)))) - (assert-equal '(:baz :foo :bar) *list*))) + (handler-bind ((silly-condition #'handle-silly-condition) + (most-silly-condition #'handle-most-silly-condition)) + (handler-bind ((very-silly-condition #'handle-very-silly-condition)) + (signal (make-condition 'most-silly-condition)))) + (assert-equal '(:most-silly-condition + :silly-condition + :very-silly-condition) + *list*))) (define-test same-handler ;; The same handler may be bound multiple times. (let ((*list* '())) - (handler-bind ((foo #'handle-foo) - (foo #'handle-foo)) - (handler-bind ((bar #'handle-bar) - (foo #'handle-foo) - (bar #'handle-bar)) - (signal (make-condition 'baz)))) - (assert-equal '(:foo :foo :bar :foo :bar) *list*))) + (handler-bind ((silly-condition #'handle-silly-condition) + (silly-condition #'handle-silly-condition)) + (handler-bind ((very-silly-condition #'handle-very-silly-condition) + (silly-condition #'handle-silly-condition) + (very-silly-condition #'handle-very-silly-condition)) + (signal (make-condition 'most-silly-condition)))) + (assert-equal '(:silly-condition + :silly-condition + :very-silly-condition + :silly-condition + :very-silly-condition) + *list*))) (define-test handler-types ;; A handler is not executed if it does not match the condition type. (let ((*list* '())) - (handler-bind ((foo #'handle-foo) - (bar #'handle-bar) - (baz #'handle-baz)) - (signal (make-condition 'bar))) - (assert-equal '(:bar :foo) *list*))) + (handler-bind ((silly-condition #'handle-silly-condition) + (very-silly-condition #'handle-very-silly-condition) + (most-silly-condition #'handle-most-silly-condition)) + (signal (make-condition 'very-silly-condition))) + (assert-equal '(:very-silly-condition :silly-condition) *list*))) (define-test handler-transfer-of-control ;; A handler may decline to handle the condition if it returns normally, ;; or it may handle the condition by transferring control elsewhere. (let ((*list* '())) (block my-block - (handler-bind ((foo #'handle-foo) - (foo (lambda (condition) - (declare (ignore condition)) - (return-from my-block))) - (foo #'handle-foo)) - (signal (make-condition 'foo)))) - (assert-equal '(:foo) *list*))) + (handler-bind ((silly-condition #'handle-silly-condition) + (silly-condition (lambda (condition) + (declare (ignore condition)) + (return-from my-block))) + (silly-condition #'handle-silly-condition)) + (signal (make-condition 'silly-condition)))) + (assert-equal '(:silly-condition) *list*))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/koans/condition-handlers.lisp b/koans/condition-handlers.lisp index 80b0a194..c18d1d6a 100644 --- a/koans/condition-handlers.lisp +++ b/koans/condition-handlers.lisp @@ -64,70 +64,70 @@ (defvar *list*) -(define-condition foo () ()) +(define-condition silly-condition () ()) -(define-condition bar (foo) ()) +(define-condition very-silly-condition (silly-condition) ()) -(define-condition baz (bar) ()) +(define-condition most-silly-condition (very-silly-condition) ()) -(defun handle-foo (condition) +(defun handle-silly-condition (condition) (declare (ignore condition)) - (push :foo *list*)) + (push :silly-condition *list*)) -(defun handle-bar (condition) +(defun handle-very-silly-condition (condition) (declare (ignore condition)) - (push :bar *list*)) + (push :very-silly-condition *list*)) -(defun handle-baz (condition) +(defun handle-most-silly-condition (condition) (declare (ignore condition)) - (push :baz *list*)) + (push :most-silly-condition *list*)) (define-test handler-bind ;; When a condition is signaled, all handlers whose type matches the ;; condition's type are allowed to execute. (let ((*list* '())) - (handler-bind ((bar #'handle-bar) - (foo #'handle-foo) - (baz #'handle-baz)) - (signal (make-condition 'baz))) + (handler-bind ((very-silly-condition #'handle-very-silly-condition) + (silly-condition #'handle-silly-condition) + (most-silly-condition #'handle-most-silly-condition)) + (signal (make-condition 'most-silly-condition))) (assert-equal ____ *list*))) (define-test handler-order ;; The order of binding handlers matters. (let ((*list* '())) - (handler-bind ((foo #'handle-foo) - (bar #'handle-bar) - (baz #'handle-baz)) - (signal (make-condition 'baz))) + (handler-bind ((silly-condition #'handle-silly-condition) + (very-silly-condition #'handle-very-silly-condition) + (most-silly-condition #'handle-most-silly-condition)) + (signal (make-condition 'most-silly-condition))) (assert-equal ____ *list*))) (define-test multiple-handler-binds ;; It is possible to bind handlers in steps. (let ((*list* '())) - (handler-bind ((foo #'handle-foo) - (baz #'handle-baz)) - (handler-bind ((bar #'handle-bar)) - (signal (make-condition 'baz)))) + (handler-bind ((silly-condition #'handle-silly-condition) + (most-silly-condition #'handle-most-silly-condition)) + (handler-bind ((very-silly-condition #'handle-very-silly-condition)) + (signal (make-condition 'most-silly-condition)))) (assert-equal ____ *list*))) (define-test same-handler ;; The same handler may be bound multiple times. (let ((*list* '())) - (handler-bind ((foo #'handle-foo) - (foo #'handle-foo)) - (handler-bind ((bar #'handle-bar) - (foo #'handle-foo) - (bar #'handle-bar)) - (signal (make-condition 'baz)))) + (handler-bind ((silly-condition #'handle-silly-condition) + (silly-condition #'handle-silly-condition)) + (handler-bind ((very-silly-condition #'handle-very-silly-condition) + (silly-condition #'handle-silly-condition) + (very-silly-condition #'handle-very-silly-condition)) + (signal (make-condition 'most-silly-condition)))) (assert-equal ____ *list*))) (define-test handler-types ;; A handler is not executed if it does not match the condition type. (let ((*list* '())) - (handler-bind ((foo #'handle-foo) - (bar #'handle-bar) - (baz #'handle-baz)) - (signal (make-condition 'bar))) + (handler-bind ((silly-condition #'handle-silly-condition) + (very-silly-condition #'handle-very-silly-condition) + (most-silly-condition #'handle-most-silly-condition)) + (signal (make-condition 'very-silly-condition))) (assert-equal ____ *list*))) (define-test handler-transfer-of-control @@ -135,12 +135,12 @@ ;; or it may handle the condition by transferring control elsewhere. (let ((*list* '())) (block my-block - (handler-bind ((foo #'handle-foo) - (foo (lambda (condition) - (declare (ignore condition)) - (return-from my-block))) - (foo #'handle-foo)) - (signal (make-condition 'foo)))) + (handler-bind ((silly-condition #'handle-silly-condition) + (silly-condition (lambda (condition) + (declare (ignore condition)) + (return-from my-block))) + (silly-condition #'handle-silly-condition)) + (signal (make-condition 'silly-condition)))) (assert-equal ____ *list*))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; From f244b35cc1552ad2cfbb6f5baf4b3d74fe38691b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Thu, 21 May 2020 19:17:13 +0200 Subject: [PATCH 119/133] Fix broken LOOP-COLLECT test --- koans-solved/loops.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/koans-solved/loops.lisp b/koans-solved/loops.lisp index 0d7c2b73..ad3ae1fa 100644 --- a/koans-solved/loops.lisp +++ b/koans-solved/loops.lisp @@ -20,7 +20,7 @@ (let* ((result-1 (loop for letter in '(#\a #\b #\c #\d) collect letter)) (result-2 (loop for number in '(1 2 3 4 5) sum number)) (result-3 (loop for list in '((foo) (bar) (baz)) append list))) - (assert-equal '(#\a \b #\c #\d) result-1) + (assert-equal '(#\a #\b #\c #\d) result-1) (assert-equal 15 result-2) (assert-equal '(foo bar baz) result-3))) From 80a6456b5e682cd76ef9fb679c8d543e58327dc3 Mon Sep 17 00:00:00 2001 From: janEbert Date: Tue, 23 Jun 2020 16:17:12 +0200 Subject: [PATCH 120/133] Adjust blanks to be the same length This way, the test framework can throw the correct errors for these tests as it only allows blanks of exactly four underscores. --- koans/functions.lisp | 4 ++-- koans/strings.lisp | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/koans/functions.lisp b/koans/functions.lisp index ae8b6a93..cf67ffc7 100644 --- a/koans/functions.lisp +++ b/koans/functions.lisp @@ -122,8 +122,8 @@ (assert-equal ____ (funcall (fourth functions) 2 33)))) (define-test lambda-with-optional-parameters - (assert-equal ___ ((lambda (a &optional (b 100)) (+ a b)) 10 9)) - (assert-equal ___ ((lambda (a &optional (b 100)) (+ a b)) 10))) + (assert-equal ____ ((lambda (a &optional (b 100)) (+ a b)) 10 9)) + (assert-equal ____ ((lambda (a &optional (b 100)) (+ a b)) 10))) (defun make-adder (x) ;; MAKE-ADDER will create a function that closes over the parameter X. diff --git a/koans/strings.lisp b/koans/strings.lisp index 7b4c71ce..dcf8850e 100644 --- a/koans/strings.lisp +++ b/koans/strings.lisp @@ -26,7 +26,7 @@ (let ((string "this is a multi line string")) - (true-or-false? ___ (typep string 'string)))) + (true-or-false? ____ (typep string 'string)))) (define-test escapes-in-strings ;; Quotes and backslashes in Lisp strings must be escaped. From 6359cac7d926c606cf68e2cea6446e0fe8a76c25 Mon Sep 17 00:00:00 2001 From: Mateusz Piotrowski <0mp@FreeBSD.org> Date: Thu, 1 Oct 2020 10:10:40 +0200 Subject: [PATCH 121/133] Change shebang to /bin/sh The whole script does not depend on any Bash features, even README suggests to use sh(1) to run this script. Also, this script can be used on other non-Linux platforms, like FreeBSD, where /bin/bash is not available (Bash is usually installed somewhere else). --- meditate-macos.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/meditate-macos.sh b/meditate-macos.sh index ca184013..2b30706f 100644 --- a/meditate-macos.sh +++ b/meditate-macos.sh @@ -1,4 +1,4 @@ -#!/bin/bash +#!/bin/sh if [ $# != 1 ]; then echo "usage: sh meditate.sh " From fbf1d7a92c295e5457612ac161316b9e57cb3994 Mon Sep 17 00:00:00 2001 From: Mateusz Piotrowski <0mp@FreeBSD.org> Date: Thu, 1 Oct 2020 10:23:14 +0200 Subject: [PATCH 122/133] Fix meditate-macos.sh to stop on Ctrl-C Previously, when a user hit Ctrl-C to send SIGINT to stop the script, fswatch would exit with 0 anyway. This made the while loop loop forever, because it was not possible to stop it in an intuitive way. This patch fixes it by figuring out whether fswatch exited because of a file system notification or a signal. If fswatch produces no output, it means it received a signal and exited. If it printed something, it's probably a path, so it means there is a file change. --- meditate-macos.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/meditate-macos.sh b/meditate-macos.sh index ca184013..e78e3a3d 100644 --- a/meditate-macos.sh +++ b/meditate-macos.sh @@ -39,6 +39,6 @@ else fi $CONTEMPLATE -while fswatch --exclude '#.*#' -r1 koans; do +while fswatch --exclude '#.*#' -r1 koans | grep .; do $CONTEMPLATE done From e0e67bea9dcf68778889a2d22224a6226347671d Mon Sep 17 00:00:00 2001 From: Kaijie Chen Date: Fri, 18 Dec 2020 20:35:03 +0800 Subject: [PATCH 123/133] Adjust position of the blanks This way, the test framework can throw the correct errors for this test as it only allows blanks to appear first. Also, adjust the answer correspondingly. --- koans-solved/let.lisp | 8 ++++---- koans/let.lisp | 8 ++++---- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/koans-solved/let.lisp b/koans-solved/let.lisp index f3a47cbf..778e9072 100644 --- a/koans-solved/let.lisp +++ b/koans-solved/let.lisp @@ -17,14 +17,14 @@ ;; created: a symbol that names a variable becomes bound to a value. (let ((x 10) (y 20)) - (assert-equal (+ x y) 30) + (assert-equal 30 (+ x y)) ;; It is possible to shadow previously visible bindings. (let ((y 30)) - (assert-equal (+ x y) 40)) - (assert-equal (+ x y) 30)) + (assert-equal 40 (+ x y))) + (assert-equal 30 (+ x y))) ;; Variables bound by LET have a default value of NIL. (let (x) - (assert-equal x nil))) + (assert-equal nil x))) (define-test let-versus-let* ;; LET* is similar to LET, except the bindings are established sequentially, diff --git a/koans/let.lisp b/koans/let.lisp index fef4a9a2..4f9b08e1 100644 --- a/koans/let.lisp +++ b/koans/let.lisp @@ -17,14 +17,14 @@ ;; created: a symbol that names a variable becomes bound to a value. (let ((x 10) (y 20)) - (assert-equal (+ x y) ____) + (assert-equal ____ (+ x y)) ;; It is possible to shadow previously visible bindings. (let ((y 30)) - (assert-equal (+ x y) ____)) - (assert-equal (+ x y) ____)) + (assert-equal ____ (+ x y))) + (assert-equal ____ (+ x y))) ;; Variables bound by LET have a default value of NIL. (let (x) - (assert-equal x ____))) + (assert-equal ____ x))) (define-test let-versus-let* ;; LET* is similar to LET, except the bindings are established sequentially, From c4ef10efa5e3fc94dae8b0b70d0d1e810ce062a4 Mon Sep 17 00:00:00 2001 From: BlacAmDK Date: Mon, 18 Jan 2021 22:24:59 +0800 Subject: [PATCH 124/133] fix triangle function fix triangle function logic --- koans-solved/triangle-project.lisp | 1 + 1 file changed, 1 insertion(+) diff --git a/koans-solved/triangle-project.lisp b/koans-solved/triangle-project.lisp index a5a6ea34..c5058840 100644 --- a/koans-solved/triangle-project.lisp +++ b/koans-solved/triangle-project.lisp @@ -27,6 +27,7 @@ (cond ((<= (+ min mid) max) (error 'triangle-error :sides (list a b c))) ((= max mid min) :equilateral) ((= max mid) :isosceles) + ((= mid min) :isosceles) (t :scalene)))) (define-test equilateral-triangles From 5c46636b0a0ee1a620aa6dbe3f6a8f821185ef51 Mon Sep 17 00:00:00 2001 From: BlacAmDK Date: Mon, 18 Jan 2021 23:34:22 +0800 Subject: [PATCH 125/133] Add test case for fixed version triangle function --- koans-solved/triangle-project.lisp | 1 + koans/triangle-project.lisp | 1 + 2 files changed, 2 insertions(+) diff --git a/koans-solved/triangle-project.lisp b/koans-solved/triangle-project.lisp index c5058840..b19f9f65 100644 --- a/koans-solved/triangle-project.lisp +++ b/koans-solved/triangle-project.lisp @@ -40,6 +40,7 @@ (assert-equal :isosceles (triangle 3 4 4)) (assert-equal :isosceles (triangle 4 3 4)) (assert-equal :isosceles (triangle 4 4 3)) + (assert-equal :isosceles (triangle 2 2 3)) (assert-equal :isosceles (triangle 10 10 2))) (define-test scalene-triangles diff --git a/koans/triangle-project.lisp b/koans/triangle-project.lisp index 275f0340..a08da931 100644 --- a/koans/triangle-project.lisp +++ b/koans/triangle-project.lisp @@ -30,6 +30,7 @@ (assert-equal :isosceles (triangle 3 4 4)) (assert-equal :isosceles (triangle 4 3 4)) (assert-equal :isosceles (triangle 4 4 3)) + (assert-equal :isosceles (triangle 2 2 3)) (assert-equal :isosceles (triangle 10 10 2))) (define-test scalene-triangles From 84c5757d099d8d9e81fce90683ac09f51d5d280e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jonas=20W=C3=B6gerbauer?= Date: Sun, 16 Oct 2022 20:17:27 +0200 Subject: [PATCH 126/133] Multiple typo fixes Corrected for some typos I found while working through the exercises. Both in "./koans" and "./koans-solved". --- koans-solved/backquote.lisp | 6 +++--- koans-solved/condition-handlers.lisp | 2 +- koans-solved/control-statements.lisp | 2 +- koans-solved/mapcar-and-reduce.lisp | 2 +- koans-solved/nil-false-empty.lisp | 2 +- koans/backquote.lisp | 6 +++--- koans/condition-handlers.lisp | 2 +- koans/control-statements.lisp | 2 +- koans/mapcar-and-reduce.lisp | 2 +- koans/nil-false-empty.lisp | 2 +- 10 files changed, 14 insertions(+), 14 deletions(-) diff --git a/koans-solved/backquote.lisp b/koans-solved/backquote.lisp index e1a187d3..fef6945e 100644 --- a/koans-solved/backquote.lisp +++ b/koans-solved/backquote.lisp @@ -26,7 +26,7 @@ ;; , unquotes a part of the expression. (assert-equal '((123) 45 6 z) `(,x 45 6 z)) (assert-equal '((123) 45 6 (7 8 9)) `(,x 45 6 ,z)) - ;; ,@ splices an expression into the into the list surrounding it. + ;; ,@ splices an expression into the list surrounding it. (assert-equal '((123) 45 6 7 8 9) `(,x 45 6 ,@z)) (assert-equal '(123 45 6 7 8 9) `(,@x 45 6 ,@z)))) @@ -34,7 +34,7 @@ ;; Because of its properties, backquote is useful for constructing Lisp forms ;; that are macroexpansions or parts of macroexpansions. (let ((variable 'x)) - ;; Fill in the blank without without using backquote/unquote notation. + ;; Fill in the blank without using backquote/unquote notation. (assert-equal '(if (typep x 'string) (format nil "The value of ~A is ~A" 'x x) (error 'type-error :datum x :expected-type 'string)) @@ -44,7 +44,7 @@ :expected-type 'string)))) (let ((error-type 'type-error) (error-arguments '(:datum x :expected-type 'string))) - ;; Fill in the blank without without using backquote/unquote notation. + ;; Fill in the blank without using backquote/unquote notation. (assert-equal '(if (typep x 'string) (format nil "The value of ~A is ~A" 'x x) (error 'type-error :datum x :expected-type 'string)) diff --git a/koans-solved/condition-handlers.lisp b/koans-solved/condition-handlers.lisp index 7d7bee16..36d5ef46 100644 --- a/koans-solved/condition-handlers.lisp +++ b/koans-solved/condition-handlers.lisp @@ -186,7 +186,7 @@ (assert-equal '(:my-error) *list*))) (define-test handler-case-type - ;; A handler cases is not executed if it does not match the condition type. + ;; A handler case is not executed if it does not match the condition type. (let ((*list* '())) (handler-case (signal (make-condition 'error)) (my-error (condition) (handle-my-error condition)) diff --git a/koans-solved/control-statements.lisp b/koans-solved/control-statements.lisp index 48b73a1a..1fe0acd3 100644 --- a/koans-solved/control-statements.lisp +++ b/koans-solved/control-statements.lisp @@ -16,7 +16,7 @@ ;; IF only evaluates and returns one branch of a conditional expression. (assert-equal :true (if t :true :false)) (assert-equal :false (if nil :true :false)) - ;; This also applies to side effects that migh or might not be evaluated. + ;; This also applies to side effects that might or might not be evaluated. (let ((result)) (if t (setf result :true) diff --git a/koans-solved/mapcar-and-reduce.lisp b/koans-solved/mapcar-and-reduce.lisp index 57743479..d05b542b 100644 --- a/koans-solved/mapcar-and-reduce.lisp +++ b/koans-solved/mapcar-and-reduce.lisp @@ -16,7 +16,7 @@ (define-test mapcar (let ((numbers '(1 2 3 4 5 6))) - ;; Inside MAPCAR, he function 1+ will be applied to each element of NUMBERS. + ;; Inside MAPCAR, the function 1+ will be applied to each element of NUMBERS. ;; A new list will be collected from the results. (assert-equal '(2 3 4 5 6 7) (mapcar #'1+ numbers)) (assert-equal '(-1 -2 -3 -4 -5 -6) (mapcar #'- numbers)) diff --git a/koans-solved/nil-false-empty.lisp b/koans-solved/nil-false-empty.lisp index ebbd6ebd..e8322115 100644 --- a/koans-solved/nil-false-empty.lisp +++ b/koans-solved/nil-false-empty.lisp @@ -46,7 +46,7 @@ (define-test or ;; The logical operator OR can also take multiple arguments. - (true-or-false? t (or nil nil nil t nil)) + (true-or-false? t (or nil nil nil t nil)) ;; OR returns the first non-NIL value it encounters, or NIL if there are none. (assert-equal nil (or nil nil nil)) (assert-equal 1 (or 1 2 3 4 5))) diff --git a/koans/backquote.lisp b/koans/backquote.lisp index c66deba1..1304cae8 100644 --- a/koans/backquote.lisp +++ b/koans/backquote.lisp @@ -26,7 +26,7 @@ ;; , unquotes a part of the expression. (assert-equal ____ `(,x 45 6 z)) (assert-equal ____ `(,x 45 6 ,z)) - ;; ,@ splices an expression into the into the list surrounding it. + ;; ,@ splices an expression into the list surrounding it. (assert-equal ____ `(,x 45 6 ,@z)) (assert-equal ____ `(,@x 45 6 ,@z)))) @@ -34,7 +34,7 @@ ;; Because of its properties, backquote is useful for constructing Lisp forms ;; that are macroexpansions or parts of macroexpansions. (let ((variable 'x)) - ;; Fill in the blank without without using backquote/unquote notation. + ;; Fill in the blank without using backquote/unquote notation. (assert-equal ____ `(if (typep ,variable 'string) (format nil "The value of ~A is ~A" ',variable ,variable) @@ -42,7 +42,7 @@ :expected-type 'string)))) (let ((error-type 'type-error) (error-arguments '(:datum x :expected-type 'string))) - ;; Fill in the blank without without using backquote/unquote notation. + ;; Fill in the blank without using backquote/unquote notation. (assert-equal ____ `(if (typep x 'string) (format nil "The value of ~A is ~A" 'x x) diff --git a/koans/condition-handlers.lisp b/koans/condition-handlers.lisp index c18d1d6a..90208a10 100644 --- a/koans/condition-handlers.lisp +++ b/koans/condition-handlers.lisp @@ -172,7 +172,7 @@ (assert-equal ____ *list*))) (define-test handler-case-type - ;; A handler cases is not executed if it does not match the condition type. + ;; A handler case is not executed if it does not match the condition type. (let ((*list* '())) (handler-case (signal (make-condition 'error)) (my-error (condition) (handle-my-error condition)) diff --git a/koans/control-statements.lisp b/koans/control-statements.lisp index 13ba43b4..93489b1a 100644 --- a/koans/control-statements.lisp +++ b/koans/control-statements.lisp @@ -16,7 +16,7 @@ ;; IF only evaluates and returns one branch of a conditional expression. (assert-equal ____ (if t :true :false)) (assert-equal ____ (if nil :true :false)) - ;; This also applies to side effects that migh or might not be evaluated. + ;; This also applies to side effects that might or might not be evaluated. (let ((result)) (if t (setf result :true) diff --git a/koans/mapcar-and-reduce.lisp b/koans/mapcar-and-reduce.lisp index 76dfa830..2298a2a2 100644 --- a/koans/mapcar-and-reduce.lisp +++ b/koans/mapcar-and-reduce.lisp @@ -16,7 +16,7 @@ (define-test mapcar (let ((numbers '(1 2 3 4 5 6))) - ;; Inside MAPCAR, he function 1+ will be applied to each element of NUMBERS. + ;; Inside MAPCAR, the function 1+ will be applied to each element of NUMBERS. ;; A new list will be collected from the results. (assert-equal '(2 3 4 5 6 7) (mapcar #'1+ numbers)) (assert-equal ____ (mapcar #'- numbers)) diff --git a/koans/nil-false-empty.lisp b/koans/nil-false-empty.lisp index 6d4dd412..90c2cb77 100644 --- a/koans/nil-false-empty.lisp +++ b/koans/nil-false-empty.lisp @@ -46,7 +46,7 @@ (define-test or ;; The logical operator OR can also take multiple arguments. - (true-or-false? ____ (or nil nil nil t nil)) + (true-or-false? ____ (or nil nil nil t nil)) ;; OR returns the first non-NIL value it encounters, or NIL if there are none. (assert-equal ____ (or nil nil nil)) (assert-equal ____ (or 1 2 3 4 5))) From 1fb55dc1035511bd1c2fb59387462322ea00ef0b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jonas=20W=C3=B6gerbauer?= Date: Sun, 16 Oct 2022 21:13:44 +0200 Subject: [PATCH 127/133] Off-by-one-Error in std-method-comb.lisp As in the description above noted: "If the countdown hits zero, :BANG should be returned instead." Thus, the ':BANG'-clause should execute one function call earlier. --- koans-solved/std-method-comb.lisp | 2 +- koans/std-method-comb.lisp | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/koans-solved/std-method-comb.lisp b/koans-solved/std-method-comb.lisp index 2dbd6ab3..2576ffd7 100644 --- a/koans-solved/std-method-comb.lisp +++ b/koans-solved/std-method-comb.lisp @@ -76,7 +76,7 @@ (defmethod remaining-time :around ((object countdown)) (let ((time (call-next-method))) - (if (< 0 time) + (if (< 1 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)) diff --git a/koans/std-method-comb.lisp b/koans/std-method-comb.lisp index c05862ce..e8625220 100644 --- a/koans/std-method-comb.lisp +++ b/koans/std-method-comb.lisp @@ -76,7 +76,7 @@ (defmethod remaining-time :around ((object countdown)) (let ((time (call-next-method))) - (if (< 0 time) + (if (< 1 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)) From 4c8ebcd04edfe4b67910df72f0c5d914b8950872 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jonas=20W=C3=B6gerbauer?= Date: Sun, 16 Oct 2022 20:20:53 +0200 Subject: [PATCH 128/133] Fixing the solution in "./koans-solved" --- koans-solved/std-method-comb.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/koans-solved/std-method-comb.lisp b/koans-solved/std-method-comb.lisp index 2576ffd7..450a7493 100644 --- a/koans-solved/std-method-comb.lisp +++ b/koans-solved/std-method-comb.lisp @@ -87,7 +87,7 @@ (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)) (assert-equal :bang (remaining-time countdown)))) From a12c0a4cd52cde520927c40a6d947f928acb296e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jonas=20W=C3=B6gerbauer?= Date: Sun, 16 Oct 2022 21:58:10 +0200 Subject: [PATCH 129/133] Improved remaining-time method in std-method-comb.lisp The slot-value is now returned befor decrementation. If time is initialized with 4, the following values are: 4, 3, 2, 1, :BANG, ... --- koans-solved/std-method-comb.lisp | 9 ++++++--- koans/std-method-comb.lisp | 9 ++++++--- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/koans-solved/std-method-comb.lisp b/koans-solved/std-method-comb.lisp index 450a7493..5525b966 100644 --- a/koans-solved/std-method-comb.lisp +++ b/koans-solved/std-method-comb.lisp @@ -76,19 +76,22 @@ (defmethod remaining-time :around ((object countdown)) (let ((time (call-next-method))) - (if (< 1 time) + (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)) + ;; PROG1 returns the value of the first expression in the sequence. + (prog1 + (slot-value object 'remaining-time) + (decf (slot-value object 'remaining-time))) :bang))) (define-test countdown (let ((countdown (make-instance 'countdown :time 4))) + (assert-equal 4 (remaining-time countdown)) (assert-equal 3 (remaining-time countdown)) (assert-equal 2 (remaining-time countdown)) (assert-equal 1 (remaining-time countdown)) (assert-equal :bang (remaining-time countdown)) - (assert-equal :bang (remaining-time countdown)) (assert-equal :bang (remaining-time countdown)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/koans/std-method-comb.lisp b/koans/std-method-comb.lisp index e8625220..8d68f786 100644 --- a/koans/std-method-comb.lisp +++ b/koans/std-method-comb.lisp @@ -76,15 +76,18 @@ (defmethod remaining-time :around ((object countdown)) (let ((time (call-next-method))) - (if (< 1 time) + (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)) + ;; PROG1 returns the value of the first expression in the sequence. + (prog1 + (slot-value object 'remaining-time) + (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 4 (remaining-time countdown)) (assert-equal ____ (remaining-time countdown)) (assert-equal ____ (remaining-time countdown)) (assert-equal ____ (remaining-time countdown)) From c6da3d42ae0c19edcc454153e52c909363d0ea59 Mon Sep 17 00:00:00 2001 From: Jonas <61405892+JonasWoeg@users.noreply.github.com> Date: Mon, 17 Oct 2022 18:56:50 +0200 Subject: [PATCH 130/133] Reusing value already bound to 'time' --- koans-solved/std-method-comb.lisp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/koans-solved/std-method-comb.lisp b/koans-solved/std-method-comb.lisp index 5525b966..f0748b53 100644 --- a/koans-solved/std-method-comb.lisp +++ b/koans-solved/std-method-comb.lisp @@ -77,11 +77,11 @@ (defmethod remaining-time :around ((object countdown)) (let ((time (call-next-method))) (if (< 0 time) + ;; PROG1 returns the value of the first expression in the sequence. ;; DECF is similar to INCF. It decreases the value stored in the place ;; and returns the decreased value. - ;; PROG1 returns the value of the first expression in the sequence. (prog1 - (slot-value object 'remaining-time) + time (decf (slot-value object 'remaining-time))) :bang))) From 27ef4a9e6b8fb33fe575ab1bc91425b340f75a07 Mon Sep 17 00:00:00 2001 From: Jonas <61405892+JonasWoeg@users.noreply.github.com> Date: Mon, 17 Oct 2022 18:58:58 +0200 Subject: [PATCH 131/133] Reusing time variable --- koans/std-method-comb.lisp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/koans/std-method-comb.lisp b/koans/std-method-comb.lisp index 8d68f786..61cbdd2f 100644 --- a/koans/std-method-comb.lisp +++ b/koans/std-method-comb.lisp @@ -77,11 +77,11 @@ (defmethod remaining-time :around ((object countdown)) (let ((time (call-next-method))) (if (< 0 time) + ;; PROG1 returns the value of the first expression in the sequence. ;; DECF is similar to INCF. It decreases the value stored in the place ;; and returns the decreased value. - ;; PROG1 returns the value of the first expression in the sequence. (prog1 - (slot-value object 'remaining-time) + time (decf (slot-value object 'remaining-time))) :bang))) From 43158d8c0eca7e36857dfe8bb49f81881038a78d Mon Sep 17 00:00:00 2001 From: Googler Date: Tue, 3 Jan 2023 14:01:46 +0000 Subject: [PATCH 132/133] Fix minor typos PiperOrigin-RevId: 499196219 --- BUILD | 2 +- koans-solved/atoms-vs-lists.lisp | 2 +- koans-solved/basic-macros.lisp | 6 +++--- koans-solved/functions.lisp | 2 +- koans-solved/hash-tables.lisp | 2 +- koans-solved/nil-false-empty.lisp | 2 +- koans-solved/structures.lisp | 4 ++-- koans/atoms-vs-lists.lisp | 2 +- koans/basic-macros.lisp | 6 +++--- koans/functions.lisp | 2 +- koans/hash-tables.lisp | 2 +- koans/nil-false-empty.lisp | 2 +- koans/structures.lisp | 4 ++-- 13 files changed, 19 insertions(+), 19 deletions(-) diff --git a/BUILD b/BUILD index bf87c5fb..f70fc4d5 100644 --- a/BUILD +++ b/BUILD @@ -1,5 +1,5 @@ # Description: Common Lisp lisp-koans -licenses(["notice"]) # Apache License 2.0 at //third_party/lisp/lisp-koans/LICENSE +licenses(["notice"]) exports_files(["LICENSE"]) diff --git a/koans-solved/atoms-vs-lists.lisp b/koans-solved/atoms-vs-lists.lisp index ef1c2fe3..0fa78cf0 100644 --- a/koans-solved/atoms-vs-lists.lisp +++ b/koans-solved/atoms-vs-lists.lisp @@ -12,7 +12,7 @@ ;;; See the License for the specific language governing permissions and ;;; limitations under the License. -;;; Lists in lisp are forms beginning and ending with rounded parentheses. +;;; Lists in Lisp are forms beginning and ending with rounded parentheses. ;;; Atoms are symbols, numbers, or other forms usually separated by whitespace ;;; or parentheses. diff --git a/koans-solved/basic-macros.lisp b/koans-solved/basic-macros.lisp index dc6caba7..36c8ccb2 100644 --- a/koans-solved/basic-macros.lisp +++ b/koans-solved/basic-macros.lisp @@ -54,7 +54,7 @@ (defun match-special-cases (thing) ;; T or OTHERWISE passed as the key matches any value. ;; NIL passed as the key matches no values. - ;; These symbols need to passed in parentheses. + ;; These symbols need to be passed in parentheses. (case thing ((t) :found-a-t) ((nil) :found-a-nil) @@ -85,8 +85,8 @@ ;; So far, we have been comparing objects using EQUAL, one of the Lisp ;; comparison functions. CASE compares the keys using EQL, which is distinct ;; from EQUAL. - ;; EQL is suitable for comparing numbers, characters, and objects for whom we - ;; want to check verify they are the same object. + ;; EQL is suitable for comparing numbers, characters, and objects when we + ;; want to verify they are the same object. (let* ((string "A string") (string-copy (copy-seq string))) ;; The above means that two distinct strings will not be the same under EQL, diff --git a/koans-solved/functions.lisp b/koans-solved/functions.lisp index 2b757aa9..588600d0 100644 --- a/koans-solved/functions.lisp +++ b/koans-solved/functions.lisp @@ -132,7 +132,7 @@ (defun make-adder (x) ;; MAKE-ADDER will create a function that closes over the parameter X. ;; The parameter will be remembered as a part of the environment of the - ;; returned function, which will continue refering to it. + ;; returned function, which will continue referring to it. (lambda (y) (+ x y))) (define-test lexical-closures diff --git a/koans-solved/hash-tables.lisp b/koans-solved/hash-tables.lisp index febaaec8..4e425ec0 100644 --- a/koans-solved/hash-tables.lisp +++ b/koans-solved/hash-tables.lisp @@ -69,7 +69,7 @@ (define-test hash-table-equality ;; EQUALP considers two hash tables to be equal if they have the same test and - ;; if its key-value pairs are the same under that test. + ;; if their key-value pairs are the same under that test. (let ((hash-table-1 (make-hash-table :test #'equal)) (hash-table-2 (make-hash-table :test #'equal))) (setf (gethash "one" hash-table-1) "yat") diff --git a/koans-solved/nil-false-empty.lisp b/koans-solved/nil-false-empty.lisp index e8322115..cf34dd85 100644 --- a/koans-solved/nil-false-empty.lisp +++ b/koans-solved/nil-false-empty.lisp @@ -23,7 +23,7 @@ (true-or-false? t (not '()))) (define-test in-lisp-many-things-are-true - ;; In Common Lisp, the canonical values for truth is T. + ;; In Common Lisp, the canonical value for truth is T. ;; However, everything that is non-NIL is true, too. (true-or-false? t 5) (true-or-false? nil (not 5)) diff --git a/koans-solved/structures.lisp b/koans-solved/structures.lisp index 362eddb9..ab19b953 100644 --- a/koans-solved/structures.lisp +++ b/koans-solved/structures.lisp @@ -92,7 +92,7 @@ :name "Manning" :team (list "Colts" "Broncos")))) ;; MANNING-1 and MANNING-2 are different objects... (true-or-false? nil (eq manning-1 manning-2)) - ;;...but they contain the same information. + ;; ...but they contain the same information. (true-or-false? t (equalp manning-1 manning-2)) (let ((manning-3 (copy-american-football-player manning-1))) (true-or-false? nil (eq manning-1 manning-3)) @@ -103,7 +103,7 @@ (nfl-guy-name manning-3))) (assert-equal "Rogers" (nfl-guy-name manning-1)) (assert-equal "Manning" (nfl-guy-name manning-3)) - ;; ...but modifying shared structure may affect other instances. + ;; ... but modifying shared structure may affect other instances. (setf (car (nfl-guy-team manning-1)) "Giants") (true-or-false? t (string= (car (nfl-guy-team manning-1)) (car (nfl-guy-team manning-3)))) diff --git a/koans/atoms-vs-lists.lisp b/koans/atoms-vs-lists.lisp index 62de29f1..fc0c7a4c 100644 --- a/koans/atoms-vs-lists.lisp +++ b/koans/atoms-vs-lists.lisp @@ -12,7 +12,7 @@ ;;; See the License for the specific language governing permissions and ;;; limitations under the License. -;;; Lists in lisp are forms beginning and ending with rounded parentheses. +;;; Lists in Lisp are forms beginning and ending with rounded parentheses. ;;; Atoms are symbols, numbers, or other forms usually separated by whitespace ;;; or parentheses. diff --git a/koans/basic-macros.lisp b/koans/basic-macros.lisp index d5b14c9e..5ceb6433 100644 --- a/koans/basic-macros.lisp +++ b/koans/basic-macros.lisp @@ -54,7 +54,7 @@ (defun match-special-cases (thing) ;; T or OTHERWISE passed as the key matches any value. ;; NIL passed as the key matches no values. - ;; These symbols need to passed in parentheses. + ;; These symbols need to be passed in parentheses. (case thing (____ :found-a-t) (____ :found-a-nil) @@ -85,8 +85,8 @@ ;; So far, we have been comparing objects using EQUAL, one of the Lisp ;; comparison functions. CASE compares the keys using EQL, which is distinct ;; from EQUAL. - ;; EQL is suitable for comparing numbers, characters, and objects for whom we - ;; want to check verify they are the same object. + ;; EQL is suitable for comparing numbers, characters, and objects when we + ;; want to verify they are the same object. (let* ((string "A string") (string-copy (copy-seq string))) ;; The above means that two distinct strings will not be the same under EQL, diff --git a/koans/functions.lisp b/koans/functions.lisp index cf67ffc7..789cd93f 100644 --- a/koans/functions.lisp +++ b/koans/functions.lisp @@ -128,7 +128,7 @@ (defun make-adder (x) ;; MAKE-ADDER will create a function that closes over the parameter X. ;; The parameter will be remembered as a part of the environment of the - ;; returned function, which will continue refering to it. + ;; returned function, which will continue referring to it. (lambda (y) (+ x y))) (define-test lexical-closures diff --git a/koans/hash-tables.lisp b/koans/hash-tables.lisp index 35ffb5e4..ce7763e0 100644 --- a/koans/hash-tables.lisp +++ b/koans/hash-tables.lisp @@ -69,7 +69,7 @@ (define-test hash-table-equality ;; EQUALP considers two hash tables to be equal if they have the same test and - ;; if its key-value pairs are the same under that test. + ;; if their key-value pairs are the same under that test. (let ((hash-table-1 (make-hash-table :test #'equal)) (hash-table-2 (make-hash-table :test #'equal))) (setf (gethash "one" hash-table-1) "yat") diff --git a/koans/nil-false-empty.lisp b/koans/nil-false-empty.lisp index 90c2cb77..e5677dec 100644 --- a/koans/nil-false-empty.lisp +++ b/koans/nil-false-empty.lisp @@ -23,7 +23,7 @@ (true-or-false? ____ (not '()))) (define-test in-lisp-many-things-are-true - ;; In Common Lisp, the canonical values for truth is T. + ;; In Common Lisp, the canonical value for truth is T. ;; However, everything that is non-NIL is true, too. (true-or-false? ____ 5) (true-or-false? ____ (not 5)) diff --git a/koans/structures.lisp b/koans/structures.lisp index 42f88efd..5ac37826 100644 --- a/koans/structures.lisp +++ b/koans/structures.lisp @@ -92,7 +92,7 @@ :name "Manning" :team (list "Colts" "Broncos")))) ;; MANNING-1 and MANNING-2 are different objects... (true-or-false? ____ (eq manning-1 manning-2)) - ;;...but they contain the same information. + ;; ... but they contain the same information. (true-or-false? ____ (equalp manning-1 manning-2)) (let ((manning-3 (copy-american-football-player manning-1))) (true-or-false? ____ (eq manning-1 manning-3)) @@ -103,7 +103,7 @@ (nfl-guy-name manning-3))) (assert-equal ____ (nfl-guy-name manning-1)) (assert-equal ____ (nfl-guy-name manning-3)) - ;; ...but modifying shared structure may affect other instances. + ;; ... but modifying shared structure may affect other instances. (setf (car (nfl-guy-team manning-1)) "Giants") (true-or-false? ____ (string= (car (nfl-guy-team manning-1)) (car (nfl-guy-team manning-3)))) From 531ad6bcd4daef831b299c4129caf2eedeb79245 Mon Sep 17 00:00:00 2001 From: jgodbout Date: Wed, 4 Jan 2023 20:52:29 +0000 Subject: [PATCH 133/133] Remove the todo waiting for a portable semaphore-count It's not going to happen. PiperOrigin-RevId: 499556697 --- koans-solved/threads.lisp | 3 --- koans/threads.lisp | 3 --- 2 files changed, 6 deletions(-) diff --git a/koans-solved/threads.lisp b/koans-solved/threads.lisp index 318e39f1..bc1eeebf 100644 --- a/koans-solved/threads.lisp +++ b/koans-solved/threads.lisp @@ -18,9 +18,6 @@ ;;; If you are using Quicklisp, please feel free to enable this lesson by ;;; following the instructions in the README. -;;; TODO: wait for Bordeaux Threads to implement a portable SEMAPHORE-COUNT -;;; and use it in the semaphore koans. - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-test thread-return-value diff --git a/koans/threads.lisp b/koans/threads.lisp index 318e39f1..bc1eeebf 100644 --- a/koans/threads.lisp +++ b/koans/threads.lisp @@ -18,9 +18,6 @@ ;;; If you are using Quicklisp, please feel free to enable this lesson by ;;; following the instructions in the README. -;;; TODO: wait for Bordeaux Threads to implement a portable SEMAPHORE-COUNT -;;; and use it in the semaphore koans. - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-test thread-return-value