diff --git a/.gitignore b/.gitignore deleted file mode 100644 index 8ccb1710..00000000 --- a/.gitignore +++ /dev/null @@ -1,4 +0,0 @@ -# ignore some editor temp files -*~ -.#* -.*.sw? \ No newline at end of file diff --git a/.koans b/.koans index 3d09049b..89d6da5b 100644 --- a/.koans +++ b/.koans @@ -1,29 +1,34 @@ ( - :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 - :type-checking - :clos - :dice-project - :macros - :scope-and-extent - #+sb-thread :threads -) + #:asserts + #:nil-false-empty + #:evaluation + #:atoms-vs-lists + #:let + #:scope-and-extent + #:basic-macros + #:lists + #:arrays + #:vectors + #:multiple-values + #:equality-distinctions + #:hash-tables + #:functions + #:strings + #:structures + #:iteration + #:mapcar-and-reduce + #:control-statements + #:loops + #:scoring-project + #:format + #:type-checking + #:clos + #:std-method-comb + #:condition-handlers + #:triangle-project + #:dice-project + #:backquote + #:macros + #+quicklisp #:threads + #:extra-credit + ) diff --git a/BUILD b/BUILD new file mode 100644 index 00000000..f70fc4d5 --- /dev/null +++ b/BUILD @@ -0,0 +1,5 @@ +# Description: Common Lisp lisp-koans + +licenses(["notice"]) + +exports_files(["LICENSE"]) 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. diff --git a/README.md b/README.md index 2ea734dd..14de9912 100644 --- a/README.md +++ b/README.md @@ -1,46 +1,89 @@ -Getting Started ---------------- +# Lisp Koans -From a terminal, execute your lisp interpreter on the file 'contemplate.lsp' e.g. +## Getting Started - sbcl --script contemplate.lsp +### One-time Method + +From a terminal, execute your lisp interpreter on the file 'contemplate.lisp' e.g. + + 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.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: + + $ cd lisp-koans + $ sh meditate-linux.sh # on Linux + $ sh meditate-macos.sh # on MacOS + +## Results of Contemplation 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.lsp" - 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.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 - "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. -Quoting the Ruby Koans instructions:: -------------------------------------- +### 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, + "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 @@ -48,12 +91,18 @@ 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. +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 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.lisp, or if they know +quicklisp will be loaded while running contemplate.lisp do nothing. diff --git a/TODO b/TODO index 5d81a3f4..88cddc7e 100644 --- a/TODO +++ b/TODO @@ -1,7 +1 @@ -* 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 - - +* improve error reporting from "a koan signaled an error" to something more helpful diff --git a/contemplate.lisp b/contemplate.lisp new file mode 100644 index 00000000..c9ec921a --- /dev/null +++ b/contemplate.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) + +(lisp-koans.core:main) diff --git a/contemplate.lsp b/contemplate.lsp deleted file mode 100644 index a6cf0e7a..00000000 --- a/contemplate.lsp +++ /dev/null @@ -1,207 +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. - - -(in-package :cl-user) - -;; lisp-unit defines the modules for loading / executing koans -(load "lisp-unit.lsp") - -(defpackage :lisp-koans - (:use :common-lisp) - (:use :lisp-unit) - #+sbcl (:use :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 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"))) - (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 - :use '(:common-lisp :lisp-unit #+sbcl :sb-ext))) - (setf *package* (find-package koan-group-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 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. -(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)))) - - -;; Output advice to the learner -(if (any-assert-non-pass-p) - (progn - (print-next-suggestion-message) - (format t "~%") - (print-progress-message)) - (print-completion-message)) diff --git a/koans-solved/arrays.lisp b/koans-solved/arrays.lisp new file mode 100644 index 00000000..2aaf886f --- /dev/null +++ b/koans-solved/arrays.lisp @@ -0,0 +1,72 @@ +;;; 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 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-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..0fa78cf0 --- /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..fef6945e --- /dev/null +++ b/koans-solved/backquote.lisp @@ -0,0 +1,71 @@ +;;; 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) '(x 45 6 z)) + ;; ` backquotes an expression; without any unquotes, it is equivalent to + ;; using the normal quote. + (assert-equal '(x 45 6 z) `(x 45 6 z)) + ;; , 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 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)))) + +(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 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)) + `(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 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)) + `(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? 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 (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 ((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/basic-macros.lisp b/koans-solved/basic-macros.lisp new file mode 100644 index 00000000..36c8ccb2 --- /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 be 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 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, + ;; 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..25a37a6e --- /dev/null +++ b/koans-solved/clos.lisp @@ -0,0 +1,181 @@ +;;; 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 :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 speed))) + +;;; 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 :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 speed :initarg :speed))) + +(define-test initargs + (let ((bike (make-instance 'bike :color :blue :speed 30))) + (assert-equal :blue (color bike)) + (assert-equal 30 (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 :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. + +(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 :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)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; 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? 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)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(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 :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/condition-handlers.lisp b/koans-solved/condition-handlers.lisp new file mode 100644 index 00000000..36d5ef46 --- /dev/null +++ b/koans-solved/condition-handlers.lisp @@ -0,0 +1,279 @@ +;;; 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? 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? 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? 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? 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)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; 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*) + +(define-condition silly-condition () ()) + +(define-condition very-silly-condition (silly-condition) ()) + +(define-condition most-silly-condition (very-silly-condition) ()) + +(defun handle-silly-condition (condition) + (declare (ignore condition)) + (push :silly-condition *list*)) + +(defun handle-very-silly-condition (condition) + (declare (ignore condition)) + (push :very-silly-condition *list*)) + +(defun handle-most-silly-condition (condition) + (declare (ignore condition)) + (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 ((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 ((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 ((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 ((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 ((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 ((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*))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(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 '(:error) *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 '(:my-error) *list*))) + +(define-test handler-case-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)) + (error (condition) (handle-error condition))) + (assert-equal '(:error) *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 (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) + ;; 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 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)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; 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)))) + ;; 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 + (let ((condition (handler-case (divide 6 :zero) (type-error (c) c)))) + (assert-equal :zero (type-error-datum condition)) + (let ((expected-type (type-error-expected-type condition))) + (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))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; 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 ((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. + (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 :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 "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 (type-error-expected-type condition)) + (assert-equal 5555 (type-error-datum condition))))) diff --git a/koans-solved/control-statements.lisp b/koans-solved/control-statements.lisp new file mode 100644 index 00000000..1fe0acd3 --- /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 :true (if t :true :false)) + (assert-equal :false (if nil :true :false)) + ;; This also applies to side effects that might or might not be evaluated. + (let ((result)) + (if t + (setf result :true) + (setf result :false)) + (assert-equal :true result) + (if nil + (setf result :true) + (setf result :false)) + (assert-equal :false 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 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 5 + (let ((x 0)) + (and + (setf x (+ 2 x)) + (setf x (+ 3 x)) + nil + (setf x (+ 4 x))) + x))) + +(define-test or-short-circuit + ;; OR only evaluates forms until one evaluates to non-NIL. + (assert-equal 2 + (let ((x 0)) + (or + (setf x (+ 2 x)) + (setf x (+ 3 x)) + nil + (setf x (+ 4 x))) + x))) diff --git a/koans-solved/dice-project.lisp b/koans-solved/dice-project.lisp new file mode 100644 index 00000000..e73ef66f --- /dev/null +++ b/koans-solved/dice-project.lisp @@ -0,0 +1,95 @@ +;;; 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. + ((values :accessor dice-values :initform '()))) + +;;; This method might be unnecessary, depending on how you define the slots of +;;; DICE-SET. + +;; (defmethod dice-values ((object dice-set)) +;; ____) + +(defmethod roll (count (object dice-set)) + (check-type count (integer 1)) + (setf (dice-values object) + (loop repeat count collect (1+ (random 6))))) + +(define-test make-dice-set + (let ((dice (make-instance 'dice-set))) + (assert-true (typep 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 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 condition)) + (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..4e51c5dc --- /dev/null +++ b/koans-solved/extra-credit.lisp @@ -0,0 +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. + +;;; 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. + +(define-test play-greed + ;; This page intentionally left blank. + (assert-true t)) diff --git a/koans/GREED_RULES.txt b/koans-solved/extra-credit.txt similarity index 100% rename from koans/GREED_RULES.txt rename to koans-solved/extra-credit.txt diff --git a/koans-solved/format.lisp b/koans-solved/format.lisp new file mode 100644 index 00000000..7297b31c --- /dev/null +++ b/koans-solved/format.lisp @@ -0,0 +1,109 @@ +;;; 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 "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 "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 "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 "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 "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 "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 "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 "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 "(/ 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 "[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 "[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 "the quick brown fox" + (format nil "~(~A~)" "The QuIcK BROWN fox")) + ;; Some FORMAT directives can be further adjusted with the : and @ modifiers. + (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/functions.lisp b/koans-solved/functions.lisp new file mode 100644 index 00000000..588600d0 --- /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 referring 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..4e425ec0 --- /dev/null +++ b/koans-solved/hash-tables.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. + +;;; 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 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") + (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 + ;; 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" + (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..65338f4c --- /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 108 sum)) + ;; DOLIST can optionally return a value. + (let ((sum 0)) + (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 + ;; (1- COUNT). + (let ((stack '())) + (dotimes (i 5) + (push i stack)) + (assert-equal '(4 3 2 1 0) stack)) + ;; DOTIMES can optionally return a value. + (let ((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 + ;; 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 '(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 + ;; each iteration. + (result '())) + ((> i 5) (nreverse result)) + (push i 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 + ;; looping by calling the RETURN special form. + (let ((counter 0)) + (loop (incf counter) + (when (>= counter 100) + (return counter))) + (assert-equal 100 counter)) + ;; The RETURN special form can return a value out of a LOOP. + (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/let.lisp b/koans-solved/let.lisp new file mode 100644 index 00000000..778e9072 --- /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 30 (+ x y)) + ;; It is possible to shadow previously visible bindings. + (let ((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 nil 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 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..ad3ae1fa --- /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 '(#\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 + ;; 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 '((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 + ;; 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 '(: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 '(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 '(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. + (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 '(: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 '(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 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 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))) + (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-keys 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. + (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 '(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. + (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 4 count) + (assert-equal '(10 10 10 10) result))) + +(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 10 result)) + (let ((result (loop for x in numbers + unless (evenp x) sum x))) + (assert-equal 44 result)) + (flet ((greater-than-10-p (x) (> x 10))) + (let ((result (loop for x in numbers + when (greater-than-10-p x) sum x))) + (assert-equal 34 result))))) diff --git a/koans-solved/macros.lisp b/koans-solved/macros.lisp new file mode 100644 index 00000000..74a7c707 --- /dev/null +++ b/koans-solved/macros.lisp @@ -0,0 +1,123 @@ +;;; 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!")) + '(when (= 0 (random 6)) + (when (= 0 (random 6)) + (when (= 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 3 limit)) + (assert-equal '(0 1 2 3) (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 '(0 1 2 3) (nreverse result)) + (assert-equal '(0 3 3 3 3 3) (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 '(0 1 2 3) (nreverse result)) + (assert-equal '(3 0) (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 ((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))) + (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..d05b542b --- /dev/null +++ b/koans-solved/mapcar-and-reduce.lisp @@ -0,0 +1,102 @@ +;;; 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, 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)) + (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 '(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 '(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 '(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 '(" 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 "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-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 #'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 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 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 '((((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 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 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)))) + (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..cf34dd85 --- /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 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)) + (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..9cb34ff8 --- /dev/null +++ b/koans-solved/scoring-project.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. + +;;; 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-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))) + +(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..f0748b53 --- /dev/null +++ b/koans-solved/std-method-comb.lisp @@ -0,0 +1,223 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +(defclass access-counter () + ((value :accessor value :initarg :value) + (access-count :reader access-count :initform 0))) + +;;; The generated reader, writer, and accessor functions are generic functions. +;;; The methods of a generic function are combined using a method combination; +;;; by default, the standard method combination is used. + +;;; This allows us to define :BEFORE and :AFTER methods whose code is executed +;;; before or after the primary method, and whose return values are discarded. +;;; The :BEFORE and :AFTER keywords used in this context are called qualifiers. + +(defmethod value :after ((object access-counter)) + (incf (slot-value object 'access-count))) + +(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 0 (access-count counter)) + (assert-equal 42 (value counter)) + (assert-equal 1 (access-count counter)) + (setf (value counter) 24) + (assert-equal 2 (access-count counter)) + (assert-equal 24 (value counter)) + (assert-equal 3 (access-count counter)) + ;; We read the value three more times and discard the result. + (value counter) + (value counter) + (value counter) + (assert-equal 6 (access-count counter)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; In addition to :BEFORE and :AFTER methods is also possible to write :AROUND +;;; methods, which execute instead of the primary methods. In such context, it +;;; is possible to call the primary method via CALL-NEXT-METHOD. +;;; In the standard method combination, the :AROUND method, if one exists, is +;;; executed first, and it may choose whether and how to call next methods. + +(defgeneric grab-lollipop () + (:method () :lollipop)) + +(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 :lollipop (grab-lollipop)) + (assert-equal :lollipop (grab-lollipop-while-mom-is-nearby t)) + (assert-equal :no-lollipop (grab-lollipop-while-mom-is-nearby nil))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass countdown () + ;; The countdown object represents an ongoing countdown. Each time the + ;; REMAINING-TIME function is called, it should return a number one less than + ;; the previous time that it returned. If the countdown hits zero, :BANG + ;; should be returned instead. + ((remaining-time :reader remaining-time :initarg :time))) + +(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 + 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)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; 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 2305070 (counter object))) + (let ((object (make-instance 'bigger-object))) + (frobnicate object) + (assert-equal 12345678 (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 -1/94 (counter object))) + (let ((object (make-instance 'bigger-object))) + (calculate object) + (assert-equal 197/99 (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 120000 (salary-at-company-a programmer))) + (let ((programmer (make-instance 'senior-programmer))) + (assert-equal 320000 (salary-at-company-a programmer))) + (let ((programmer (make-instance 'full-stack-programmer))) + (assert-equal 168000 (salary-at-company-a programmer))) + (let ((programmer (make-instance 'senior-full-stack-programmer))) + (assert-equal 368000 (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 120000 (salary-at-company-b programmer))) + (let ((programmer (make-instance 'senior-programmer))) + (assert-equal 240000 (salary-at-company-b programmer))) + (let ((programmer (make-instance 'full-stack-programmer))) + (assert-equal 168000 (salary-at-company-b programmer))) + (let ((programmer (make-instance 'senior-full-stack-programmer))) + (assert-equal 336000 (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..ab19b953 --- /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..bc1eeebf --- /dev/null +++ b/koans-solved/threads.lisp @@ -0,0 +1,158 @@ +;;; 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. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(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..b19f9f65 --- /dev/null +++ b/koans-solved/triangle-project.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. + +(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) + (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) + ((= mid min) :isosceles) + (t :scalene)))) + +(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 2 2 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 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 + ;; 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 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))) + (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..8afb5e29 --- /dev/null +++ b/koans-solved/type-checking.lisp @@ -0,0 +1,153 @@ +;;; 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? 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 '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? 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 + ;; 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? 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? 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)) + (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? 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 + ;; 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? 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? 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? 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? 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? 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? 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? 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 '(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/variables-parameters-constants.lsp b/koans-solved/variables-parameters-constants.lisp similarity index 79% rename from koans/variables-parameters-constants.lsp rename to koans-solved/variables-parameters-constants.lisp index 6d103980..ca960376 100644 --- a/koans/variables-parameters-constants.lsp +++ b/koans-solved/variables-parameters-constants.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. + (defun test-variable-assignment-with-setf () ;; the let pattern allows us to create local variables with ;; lexical scope. 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 new file mode 100644 index 00000000..3b1c6426 --- /dev/null +++ b/koans/arrays.lisp @@ -0,0 +1,72 @@ +;;; 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 ____ (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)) + ;; 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. + (assert-equal ____ (array-total-size chess-board)))) + +(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. + (setf (____ color-cube ____ ____ ____) ____ + (____ color-cube ____ ____ ____) ____) + (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 ____ (aref x 1 0)) + (assert-equal ____ (array-dimensions x)) + (adjust-array x '(3 4)) + (assert-equal ____ (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 ____ (array-dimensions x)) + (assert-equal ____ (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 ____ (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)))) diff --git a/koans/arrays.lsp b/koans/arrays.lsp deleted file mode 100644 index 137049db..00000000 --- a/koans/arrays.lsp +++ /dev/null @@ -1,79 +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. - - -;; see http://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node157.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" - (dotimes (x 8) - (dotimes (y 8) - (if (evenp (+ x y)) - (setf (aref chess-board x y) :black) - (setf (aref chess-board x y) :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)))) - -(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" - (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 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)) - (adjust-array x '(3 4)) - (assert-equal (array-dimensions x) '(3 4)) - (assert-equal (aref x 2 3) ____))) - - -(define-test test-make-array-from-list - (let ((x)) - (setf 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))) - (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 diff --git a/koans/asserts.lisp b/koans/asserts.lisp new file mode 100644 index 00000000..8093e150 --- /dev/null +++ b/koans/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) + (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 ____)) + +(define-test true-or-false + (true-or-false? ____ (= 34 34)) + (true-or-false? ____ (= 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) + ;; 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/asserts.lsp b/koans/asserts.lsp deleted file mode 100644 index 476b196f..00000000 --- a/koans/asserts.lsp +++ /dev/null @@ -1,47 +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. - - -; 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. - - -; 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 assert-true - "t is true. Replace the blank with a t" - (assert-true ___)) - -(define-test assert-false - "nil is false" - (assert-false ___)) - -(define-test fill-in-the-blank - "sometimes you will need to fill the blank to complete" - (assert-equal 2 ___)) - -(define-test fill-in-the-blank-string - (assert-equal ___ "hello world")) - -(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))) - - diff --git a/koans/atoms-vs-lists.lisp b/koans/atoms-vs-lists.lisp new file mode 100644 index 00000000..fc0c7a4c --- /dev/null +++ b/koans/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? ____ (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/atoms-vs-lists.lsp b/koans/atoms-vs-lists.lsp deleted file mode 100644 index ce49da87..00000000 --- a/koans/atoms-vs-lists.lsp +++ /dev/null @@ -1,48 +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. - - -(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))) diff --git a/koans/backquote.lisp b/koans/backquote.lisp new file mode 100644 index 00000000..1304cae8 --- /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 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 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 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/basic-macros.lisp b/koans/basic-macros.lisp new file mode 100644 index 00000000..5ceb6433 --- /dev/null +++ b/koans/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 ____ 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 be 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 (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. + ____ + ____ + ____ + (: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 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, + ;; 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 (case string + ("A string" :matched) + (t :not-matched)))) + (assert-equal ____ 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 ____ result))) diff --git a/koans/clos.lisp b/koans/clos.lisp new file mode 100644 index 00000000..44822d6f --- /dev/null +++ b/koans/clos.lisp @@ -0,0 +1,181 @@ +;;; 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)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; 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 speed))) + +;;; 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 speed :initarg :speed))) + +(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 :clang))) + (assert-equal ____ (person-name jack)) + (assert-equal ____ (person-name bob)) + (assert-equal ____ (favorite-lisp-implementation bob)) + (assert-equal ____ (person-name adam)) + (assert-equal ____ (favorite-c-compiler adam)) + (true-or-false? ____ (typep bob 'person)) + (true-or-false? ____ (typep bob 'lisp-programmer)) + (true-or-false? ____ (typep bob 'c-programmer)))) + +;;; 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 'clisp-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/clos.lsp b/koans/clos.lsp deleted file mode 100644 index f3c4a72d..00000000 --- a/koans/clos.lsp +++ /dev/null @@ -1,181 +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. - - -;; 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 - -(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*))) - - -;; Todo: consider adding :before and :after method control instructions. - diff --git a/koans/condition-handlers.lisp b/koans/condition-handlers.lisp new file mode 100644 index 00000000..90208a10 --- /dev/null +++ b/koans/condition-handlers.lisp @@ -0,0 +1,265 @@ +;;; 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*) + +(define-condition silly-condition () ()) + +(define-condition very-silly-condition (silly-condition) ()) + +(define-condition most-silly-condition (very-silly-condition) ()) + +(defun handle-silly-condition (condition) + (declare (ignore condition)) + (push :silly-condition *list*)) + +(defun handle-very-silly-condition (condition) + (declare (ignore condition)) + (push :very-silly-condition *list*)) + +(defun handle-most-silly-condition (condition) + (declare (ignore condition)) + (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 ((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 ((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 ((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 ((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 ((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 + ;; 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 ((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*))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(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*))) + +(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 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)) + (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 (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) + ;; 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)))) + ;; 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 + (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 ((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. + (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/condition-handlers.lsp b/koans/condition-handlers.lsp deleted file mode 100644 index ddfd5d69..00000000 --- a/koans/condition-handlers.lsp +++ /dev/null @@ -1,126 +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. - - -"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)))) - - -(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)))))) diff --git a/koans/control-statements.lisp b/koans/control-statements.lisp new file mode 100644 index 00000000..93489b1a --- /dev/null +++ b/koans/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 might 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 (+ 2 x)) + (setf x (+ 3 x)) + nil + (setf x (+ 4 x))) + x))) + +(define-test or-short-circuit + ;; OR only evaluates forms until one evaluates to non-NIL. + (assert-equal ____ + (let ((x 0)) + (or + (setf x (+ 2 x)) + (setf x (+ 3 x)) + nil + (setf x (+ 4 x))) + x))) diff --git a/koans/control-statements.lsp b/koans/control-statements.lsp deleted file mode 100644 index 3e071dcc..00000000 --- a/koans/control-statements.lsp +++ /dev/null @@ -1,68 +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. - -(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 ____))) - - -(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 ___))) - - -(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 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))) \ No newline at end of file diff --git a/koans/dice-project.lisp b/koans/dice-project.lisp new file mode 100644 index 00000000..d48f72b9 --- /dev/null +++ b/koans/dice-project.lisp @@ -0,0 +1,93 @@ +;;; 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. + (____)) + +;;; This method might be unnecessary, depending on how you define the slots of +;;; DICE-SET. + +(defmethod dice-values ((object dice-set)) + ____) + +(defmethod roll (count (object dice-set)) + ____) + +(define-test make-dice-set + (let ((dice (make-instance 'dice-set))) + (assert-true (typep 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 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 condition)) + (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/dice-project.lsp b/koans/dice-project.lsp deleted file mode 100644 index c5dda8b4..00000000 --- a/koans/dice-project.lsp +++ /dev/null @@ -1,80 +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. - - -; based on about_dice_project.rb - -;; 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 -) - -(defmethod roll (how-many (object dice-set)) - ;; WRITE ROLL METHOD DEFINITION HERE -) - - -(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 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 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 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 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))))) diff --git a/koans/equality-distinctions.lisp b/koans/equality-distinctions.lisp new file mode 100644 index 00000000..4bfb72af --- /dev/null +++ b/koans/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? ____ (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 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 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"))) + +(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? ____ (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/equality-distinctions.lsp b/koans/equality-distinctions.lsp deleted file mode 100644 index 50e0b55a..00000000 --- a/koans/equality-distinctions.lsp +++ /dev/null @@ -1,92 +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. - -;; 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"))) - -(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 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 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 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)))) - -; 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))) diff --git a/koans/evaluation.lisp b/koans/evaluation.lisp new file mode 100644 index 00000000..ef0e7a5a --- /dev/null +++ b/koans/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 ____ (+ 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 evaluation-order + ;; Arguments to a function are evaluated before the function is called. + (assert-equal ____ (* (+ 1 2) (- 13 10)))) + +(define-test basic-comparisons + ;; 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 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)) + (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/evaluation.lsp b/koans/evaluation.lsp deleted file mode 100644 index 97eacda4..00000000 --- a/koans/evaluation.lsp +++ /dev/null @@ -1,61 +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. - - -;; based on http://psg.com/~dlamkins/sl/chapter03-02.html - -(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." - - "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 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)" - (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))))) diff --git a/koans/extra-credit.lisp b/koans/extra-credit.lisp new file mode 100644 index 00000000..2bd62be9 --- /dev/null +++ b/koans/extra-credit.lisp @@ -0,0 +1,26 @@ +;;; 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. +;;; 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. + +(define-test play-greed + (assert-true ____)) diff --git a/koans/extra-credit.lsp b/koans/extra-credit.lsp deleted file mode 100644 index 03abe7c7..00000000 --- a/koans/extra-credit.lsp +++ /dev/null @@ -1,8 +0,0 @@ -;; 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 diff --git a/koans/extra-credit.txt b/koans/extra-credit.txt new file mode 100644 index 00000000..58b5a9cb --- /dev/null +++ b/koans/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/format.lisp b/koans/format.lisp new file mode 100644 index 00000000..39d0e6fa --- /dev/null +++ b/koans/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/functions.lisp b/koans/functions.lisp new file mode 100644 index 00000000..789cd93f --- /dev/null +++ b/koans/functions.lisp @@ -0,0 +1,180 @@ +;;; 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 ____ (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 ____ (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 ____ (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 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 ____ (function-with-keyword-parameters :b 22)) + ;; Keyword argument order is not important. + (assert-equal ____ (function-with-keyword-parameters :b 22 :c -5/2 :a 0)) + ;; Lisp handles duplicate keyword parameters. + (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)) + ;; 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 funky-parameters + (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. + ;; 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))) + +(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 referring 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 ____ (funcall adder-100 3)) + (assert-equal ____ (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 ____ (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/functions.lsp b/koans/functions.lsp deleted file mode 100644 index 7fcaae29..00000000 --- a/koans/functions.lsp +++ /dev/null @@ -1,231 +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. - - -; borrows from about_methods.py - -(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) - 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 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) () ) - - -(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 - (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." - (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. - -(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." - (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)))) diff --git a/koans/hash-tables.lisp b/koans/hash-tables.lisp new file mode 100644 index 00000000..ce7763e0 --- /dev/null +++ b/koans/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? ____ (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-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)) + (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 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") + (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 + ;; 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" + (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 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. + ____ + (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/hash-tables.lsp b/koans/hash-tables.lsp deleted file mode 100644 index 7afbb591..00000000 --- a/koans/hash-tables.lsp +++ /dev/null @@ -1,128 +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. - - -; 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) "ein") - (setf (gethash "two" expected) "zwei") - - (setf (gethash "one" babel-fish) "ein") - (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 ____))) - - -(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))) - - (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))))) diff --git a/koans/iteration.lisp b/koans/iteration.lisp new file mode 100644 index 00000000..5268a3b1 --- /dev/null +++ b/koans/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 ____ counter)) + ;; The RETURN special form can return a value out of a LOOP. + (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/iteration.lsp b/koans/iteration.lsp deleted file mode 100644 index b846cc48..00000000 --- a/koans/iteration.lsp +++ /dev/null @@ -1,116 +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. - - -;; 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 om 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 the 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 do-list 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 an 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 iff 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/let.lisp b/koans/let.lisp new file mode 100644 index 00000000..4f9b08e1 --- /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 new file mode 100644 index 00000000..4ed0946a --- /dev/null +++ b/koans/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 ____ 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 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 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. + (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 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)) + ;; 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 ____ (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 ____ (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 slicing-lists + ;; 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/lists.lsp b/koans/lists.lsp deleted file mode 100644 index e64f88fa..00000000 --- a/koans/lists.lsp +++ /dev/null @@ -1,109 +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. - - -;; 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))) - - -(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)))) - - -(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))) diff --git a/koans/loops.lisp b/koans/loops.lisp new file mode 100644 index 00000000..02d7e8b3 --- /dev/null +++ b/koans/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) + (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. + (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 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 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-keys 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 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)) + (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 x) sum x))) + (assert-equal ____ result))))) diff --git a/koans/loops.lsp b/koans/loops.lsp deleted file mode 100644 index 6fa3fc54..00000000 --- a/koans/loops.lsp +++ /dev/null @@ -1,165 +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. - -;; 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)))) - (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 diff --git a/koans/macros.lisp b/koans/macros.lisp new file mode 100644 index 00000000..85415138 --- /dev/null +++ b/koans/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/macros.lsp b/koans/macros.lsp deleted file mode 100644 index 769eb887..00000000 --- a/koans/macros.lsp +++ /dev/null @@ -1,162 +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. - - -;; 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 then 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 (&body body) - "records the body form to the list *log* and then evalues the body normally" - `(let ((retval ,@body)) - (push ',@body *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 (&body body) - "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)) - - ;; 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*))) diff --git a/koans/mapcar-and-reduce.lisp b/koans/mapcar-and-reduce.lisp new file mode 100644 index 00000000..2298a2a2 --- /dev/null +++ b/koans/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, 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)) + (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-equalp ____ (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/mapcar-and-reduce.lsp b/koans/mapcar-and-reduce.lsp deleted file mode 100644 index 571f4aa5..00000000 --- a/koans/mapcar-and-reduce.lsp +++ /dev/null @@ -1,82 +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. - -(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"))))) - - -(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 test-transpose-using-mapcar - "Replace WRONG-FUNCTION with the correct function (don't forget - 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) - (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 test-reduce-basics - "The reduce function applies uses a supplied - binary function to combine the elements of a - list from left to right." - (assert-equal ___ (reduce #'+ '(1 2 3 4))) - (assert-equal ___ (reduce #'expt '(2 3 2)))) - - -(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)))) diff --git a/koans/multiple-values.lisp b/koans/multiple-values.lisp new file mode 100644 index 00000000..5459c0ac --- /dev/null +++ b/koans/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 ____ (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 ____ 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/multiple-values.lsp b/koans/multiple-values.lsp deleted file mode 100644 index d3d42c3f..00000000 --- a/koans/multiple-values.lsp +++ /dev/null @@ -1,48 +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. - - - -"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)) ____)) - -(defun next-fib (a b) - (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) ____))) diff --git a/koans/nil-false-empty.lisp b/koans/nil-false-empty.lisp new file mode 100644 index 00000000..e5677dec --- /dev/null +++ b/koans/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? ____ (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 value 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/nil-false-empty.lsp b/koans/nil-false-empty.lsp deleted file mode 100644 index ca06edf3..00000000 --- a/koans/nil-false-empty.lsp +++ /dev/null @@ -1,55 +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. - -(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 diff --git a/koans/scope-and-extent.lisp b/koans/scope-and-extent.lisp new file mode 100644 index 00000000..7b5ae1b0 --- /dev/null +++ b/koans/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 ____ (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 ____ (block-1)) + (assert-equal ____ (block-2))) + +;;; 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))))) diff --git a/koans/scope-and-extent.lsp b/koans/scope-and-extent.lsp deleted file mode 100644 index da400c9d..00000000 --- a/koans/scope-and-extent.lsp +++ /dev/null @@ -1,69 +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. - - -(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 - (block here - (return-from here 4) - 5)) - -(defun code-block-02 () - (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))))) diff --git a/koans/scoring-project.lisp b/koans/scoring-project.lisp new file mode 100644 index 00000000..33aea48a --- /dev/null +++ b/koans/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/scoring-project.lsp b/koans/scoring-project.lsp deleted file mode 100644 index e4a0f785..00000000 --- a/koans/scoring-project.lsp +++ /dev/null @@ -1,85 +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. - - -;;;;;;;;;;;;;; -;; 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)))) diff --git a/koans/special-forms.lsp b/koans/special-forms.lsp deleted file mode 100644 index d4e7fb04..00000000 --- a/koans/special-forms.lsp +++ /dev/null @@ -1,118 +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 0) - (b __) - (c __)) - (assert-equal a 100) - (assert-equal b 200) - (assert-equal c "Jellyfish")) - (let* ((a 0)) - (assert-equal a 121) - (assert-equal b 200) - (assert-equal c (+ a (/ b a))))) - - -(define-test test-cond - "the cond form is like the c switch statement" - (setf a 4) - (setf c - (cond ((> a 0) :positive) - ((< a 0) :negative) - (t :zero))) - (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))) - -(define-test test-your-own-cond-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)) diff --git a/koans/std-method-comb.lisp b/koans/std-method-comb.lisp new file mode 100644 index 00000000..61cbdd2f --- /dev/null +++ b/koans/std-method-comb.lisp @@ -0,0 +1,223 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +(defclass access-counter () + ((value :accessor value :initarg :value) + (access-count :reader access-count :initform 0))) + +;;; The generated reader, writer, and accessor functions are generic functions. +;;; The methods of a generic function are combined using a method combination; +;;; by default, the standard method combination is used. + +;;; This allows us to define :BEFORE and :AFTER methods whose code is executed +;;; before or after the primary method, and whose return values are discarded. +;;; The :BEFORE and :AFTER keywords used in this context are called qualifiers. + +(defmethod value :after ((object access-counter)) + (incf (slot-value object 'access-count))) + +(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)) + (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, which execute instead of the primary methods. In such context, it +;;; is possible to call the primary method via CALL-NEXT-METHOD. +;;; In the standard method combination, the :AROUND method, if one exists, is +;;; executed first, and it may choose whether and how to call next methods. + +(defgeneric grab-lollipop () + (:method () :lollipop)) + +(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 :time))) + +(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 + 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 ____ (remaining-time countdown)) + (assert-equal ____ (remaining-time countdown)) + (assert-equal ____ (remaining-time countdown)) + (assert-equal ____ (remaining-time countdown)) + (assert-equal ____ (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/strings.lisp b/koans/strings.lisp new file mode 100644 index 00000000..dcf8850e --- /dev/null +++ b/koans/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? ____ (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 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 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)) + (assert-equal ____ (char my-string 3)) + (assert-equal ____ (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 ____ (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 ____ (position #\b "abc")) + (assert-equal ____ (position #\c "abc")) + (assert-equal ____ (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 ____ (search "supposedly" title)) + (assert-equal 12 (search ____ title)))) + diff --git a/koans/strings.lsp b/koans/strings.lsp deleted file mode 100644 index 2baf4676..00000000 --- a/koans/strings.lsp +++ /dev/null @@ -1,78 +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. - -(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)))) - diff --git a/koans/structures.lisp b/koans/structures.lisp new file mode 100644 index 00000000..5ac37826 --- /dev/null +++ b/koans/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? ____ (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 (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-3)))))) diff --git a/koans/structures.lsp b/koans/structures.lsp deleted file mode 100644 index aa04a9cb..00000000 --- a/koans/structures.lsp +++ /dev/null @@ -1,104 +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. - - -;; 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)))))) diff --git a/koans/threads.lisp b/koans/threads.lisp new file mode 100644 index 00000000..bc1eeebf --- /dev/null +++ b/koans/threads.lisp @@ -0,0 +1,158 @@ +;;; 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. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(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/threads.lsp b/koans/threads.lsp deleted file mode 100644 index 2fe6f4d8..00000000 --- a/koans/threads.lsp +++ /dev/null @@ -1,316 +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. - -;; 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' - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Making threads with sb-thread:make-thread ;; -;; Joining threads with sb-thread:join-thread ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; sb-thread 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. - -(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 - (sb-thread:make-thread - (lambda () - (setf *greeting* "hello world"))))) - (sb-thread: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) - (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 - (lambda () (* 11 99))))) - (assert-equal ____ (sb-thread: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 #'+ - :name "what is the sum of no things adding?"))) - (assert-equal (sb-thread: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 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. - -(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))))) - - -;; ---- - -(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 (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)) - (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" - (sb-thread:make-thread (lambda () (loop)) :name name)) - -(defvar *top-thread* sb-thread:*current-thread*) -(defun main-thread-p (thread) (eq thread *top-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)))) - -(defun kill-spawned-threads () - "kill all lisp threads except the main thread." - (map 'list 'kill-thread-if-not-main (sb-thread:list-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 - "list-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))) - (kill-thread-if-not-main (spawn-looping-thread "NEVER CATCH ME~! NYA NYA!")) - (sleep 0.01) - (assert-equal ___ (length (sb-thread:list-all-threads))) - (spawn-three-loopers) - (assert-equal ___ (length (sb-thread:list-all-threads))) - (kill-spawned-threads) - (sleep 0.01) - (assert-equal ___ (length (sb-thread:list-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 (sb-thread:join-thread - (sb-thread: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)))) - (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 (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) - (assert-equal *g* ___))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Global state can be protected ;; -;; with a mutex. ;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(setf *g* 0) -(defvar *gs-mutex* (sb-thread:make-mutex :name "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*) - (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) - (assert-equal *g* ___))) - -;;;;;;;;;;;;;;;; -;; Semaphores ;; -;;;;;;;;;;;;;;;; - -;; Incrementing a semaphore is an atomic operation. -(defvar *g-semaphore* (sb-thread:make-semaphore :name "g" :count 0)) - -(defun semaphore-increments-g () - (sb-thread: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*))) - - -;; 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 *orchard-log* (make-array 10)) -(defvar *next-log-idx* 0) -(defvar *orchard-log-mutex* (sb-thread:make-mutex :name "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*))) - -(defun apple-eater () - (sb-thread: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*)) - -(defun num-apples () - (sb-thread: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))) - (assert-equal (aref *orchard-log* 0) ____) - (assert-equal (aref *orchard-log* 1) ____)) - - - - diff --git a/koans/triangle-project.lisp b/koans/triangle-project.lisp new file mode 100644 index 00000000..a08da931 --- /dev/null +++ b/koans/triangle-project.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. + +(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 2 2 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 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 + ;; 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 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))) + (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/triangle-project.lsp b/koans/triangle-project.lsp deleted file mode 100644 index 9809944f..00000000 --- a/koans/triangle-project.lsp +++ /dev/null @@ -1,46 +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. - - -"you need to write the triangle method" - -(define-condition triangle-error (error) ()) - -(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))) - - -(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 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 diff --git a/koans/type-checking.lisp b/koans/type-checking.lisp new file mode 100644 index 00000000..09a3b14f --- /dev/null +++ b/koans/type-checking.lisp @@ -0,0 +1,153 @@ +;;; 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 'fixnum)) + (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 '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 + ;; 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 * *))) + (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 * (* 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/type-checking.lsp b/koans/type-checking.lsp deleted file mode 100644 index c8be8003..00000000 --- a/koans/type-checking.lsp +++ /dev/null @@ -1,120 +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. - -;; 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 ())) - (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 - (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))))) - - -(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))) - - -(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))) - - -(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" - (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)))) diff --git a/koans/variables-parameters-constants.lisp b/koans/variables-parameters-constants.lisp new file mode 100644 index 00000000..ca960376 --- /dev/null +++ b/koans/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/vectors.lisp b/koans/vectors.lisp new file mode 100644 index 00000000..70cb0b09 --- /dev/null +++ b/koans/vectors.lisp @@ -0,0 +1,53 @@ +;;; 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))) + +(defun list-to-bit-vector (list) + ;; Implement a function that turns a list into a 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/vectors.lsp b/koans/vectors.lsp deleted file mode 100644 index 751116d2..00000000 --- a/koans/vectors.lsp +++ /dev/null @@ -1,50 +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. - -"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)) - (true-or-false? ____ (typep #*1001 'bit-vector)) - (assert-equal ____ (aref #*1001 1))) - - -(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 (my-list) - nil) - -(define-test test-list-to-bit-vector - "you must complete 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/lisp-koans.lisp b/lisp-koans.lisp new file mode 100644 index 00000000..f7c53668 --- /dev/null +++ b/lisp-koans.lisp @@ -0,0 +1,133 @@ +;;; 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.core + (:use #:common-lisp + #:lisp-koans.test) + (:export #:main)) + +(in-package :lisp-koans.core) + +(defvar *all-koan-groups* + (with-open-file (in #p".koans") + (with-standard-io-syntax (read in)))) + +(defvar *collected-results* nil) + +;;; Functions for loading koans + +(defun package-name-from-group-name (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))) + (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 + :use '(#:common-lisp #:lisp-koans.test))) + (let ((*package* (find-package koan-package-name))) + (load (concatenate 'string dirname "/" koan-file-name))))) + +(defun load-all-koans (dirname) + (loop for koan-group-name in *all-koan-groups* + do (load-koan-group-named dirname koan-group-name))) + +;;; Functions for executing koans + +(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 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) + (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 (dirname) + (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. + ~A +Please meditate on the following code: + File \"~A/~(~A~).lisp\" + Koan \"~A\" + Current koan assert status is \"~A\"~%~%" + (koan-status-message koan-status) dirname filename koan-name koan-status))) + +(defun print-completion-message () + (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!~% +")) + +(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*) + (test-total-count) + (1- (length *collected-results*)) + (length *all-koan-groups*))) + +(defun output-advice (dirname) + (cond ((any-assert-non-pass-p) + (print-next-suggestion-message dirname) + (print-progress-message)) + (t (print-completion-message)))) + +;;; Main + +(defun main (&optional (dirname "koans")) + (load-all-koans dirname) + (execute-koans) + (output-advice dirname)) diff --git a/lisp-unit.lsp b/lisp-unit.lsp deleted file mode 100644 index 4bc6dba7..00000000 --- a/lisp-unit.lsp +++ /dev/null @@ -1,751 +0,0 @@ -;;;-*- 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. -|# - -;;; Packages -(in-package :cl-user) - -(defpackage :lisp-unit - (: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 - :list-tests - :test-code - :test-documentation - :remove-tests - :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 __ - ___ - ____ - +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 :set-equal)) - -(in-package :lisp-unit) - - -;; blank constants allow the incomplete tests to compile without errors -(defconstant __ :blank-value) -(defconstant ___ :blank-value) -(defconstant ____ :blank-value) -(defconstant +blanks+ '(__ ___ ____)) -(defconstant +blank-value+ 'BLANK-VALUE) - - -;;; 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)))) - -;;; 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 - :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 tag) - "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))))) - -(defmacro define-test (name &body body) - "Store the test in the test database." - (multiple-value-bind (doc tag 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))) - -;;; Manage tests - -(defun list-tests (&optional (package *package*)) - "Return a list of the tests in package." - (let ((table (package-table package))) - (when table - (loop for test-name being each hash-key in table - collect test-name)))) - -(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*) - (progn - (remhash (find-package package) *test-db*) - (remhash (find-package package) *tag-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 - -(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))) - -(defun run-tags (tags &optional (package *package*)) - "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)) - (and (listp l1) - (listp l2) - (subsetp l1 l2 :test test) - (subsetp l2 l1 :test test))) - -(pushnew :lisp-unit common-lisp:*features*) diff --git a/meditate-linux.sh b/meditate-linux.sh new file mode 100644 index 00000000..1a811327 --- /dev/null +++ b/meditate-linux.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.lisp --eval '(quit)'" + ;; + 'ccl' ) + echo "ccl -n -l contemplate.lisp -e '(quit)'" + ;; + 'clisp' ) + echo "clisp -q -norc -ansi contemplate.lisp" + ;; + 'ecl' ) + echo "ecl -norc -load contemplate.lisp -eval '(quit)'" + ;; + 'sbcl' ) + echo "sbcl --script contemplate.lisp" + ;; + * ) + 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 + $CONTEMPLATE +done diff --git a/meditate-macos.sh b/meditate-macos.sh new file mode 100644 index 00000000..dbaaeab6 --- /dev/null +++ b/meditate-macos.sh @@ -0,0 +1,44 @@ +#!/bin/sh + +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.lisp --eval '(quit)'" + ;; + 'ccl' ) + echo "ccl -n -l contemplate.lisp -e '(quit)'" + ;; + 'clisp' ) + echo "clisp -q -norc -ansi contemplate.lisp" + ;; + 'ecl' ) + echo "ecl -norc -load contemplate.lisp -eval '(quit)'" + ;; + 'sbcl' ) + echo "sbcl --script contemplate.lisp" + ;; + * ) + echo "" + exit + ;; + esac +} + +CONTEMPLATE=$(choose_command_line $1) +if [ "$CONTEMPLATE" = "" ]; then + echo "Unknown Lisp implementation." + exit +else + echo $CONTEMPLATE +fi + +$CONTEMPLATE +while fswatch --exclude '#.*#' -r1 koans | grep .; do + $CONTEMPLATE +done diff --git a/test-framework.lisp b/test-framework.lisp new file mode 100644 index 00000000..8ef1904f --- /dev/null +++ b/test-framework.lisp @@ -0,0 +1,182 @@ +;;; 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 #: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) + ;; Test blank + (:export #:____)) + +(in-package #:lisp-koans.test) + +;; The self-evaluating test blank allows many Lisp forms in the koans to compile +;; without errors. + +(defvar ____ '____) + +;;; Global unit test database + +(defparameter *test-db* (make-hash-table :test #'eq)) + +(defun package-table (package) + (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 + (pushnew (list ',name ',body) (package-table *package*) + :test (lambda (x y) (eq (car x) (car y)))) + ',name)) + +;;; Test statistics + +(defun test-count (&optional (package *package*)) + "Returns the number of tests for a package." + (let ((table (package-table package))) + (length table))) + +(defun test-total-count () + "Returns the total number of tests." + (loop for table being the hash-values of *test-db* + sum (length table))) + +;;; Test passed predicate. + +(defun test-passed-p (type expected actual test) + (ecase type + (: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)))))) + +(defun form-contains-blanks-p (form) + (typecase form + (symbol (eq form '____)) + (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) + (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 (form expected) + "Assert whether expected and form are EQ." + `(expand-assert :equal ,form ,form ,expected :test #'eq)) + +(defmacro assert-eql (form expected) + "Assert whether expected and form are EQL." + `(expand-assert :equal ,form ,form ,expected :test #'eql)) + +(defmacro assert-equal (form expected) + "Assert whether expected and form are EQUAL." + `(expand-assert :equal ,form ,form ,expected :test #'equal)) + +(defmacro assert-equalp (form expected) + "Assert whether expected and form are EQUALP." + `(expand-assert :equal ,form ,form ,expected :test #'equalp)) + +(defmacro true-or-false? (form expected) + "Assert whether expected and form are logically equivalent." + `(expand-assert :equal ,form (notnot ,form) (notnot ,expected) :test #'eql)) + +(defmacro assert-error (form condition) + "Assert whether form signals 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)) + +(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 (notnot ,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 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) + finally (return results))) diff --git a/test.lisp b/test.lisp new file mode 100644 index 00000000..9441a1dd --- /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) + +(lisp-koans.core:main "koans-solved") diff --git a/unused-test-ideas.lsp b/unused-test-ideas.lsp deleted file mode 100644 index 48d87cf1..00000000 --- a/unused-test-ideas.lsp +++ /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))) - -