From eab7b896dc29ec9016ae9032e139594cc47d662d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= Date: Fri, 8 May 2020 23:29:36 +0200 Subject: [PATCH] Test stuff, begin working on solved koans --- .koans | 2 +- README.md | 10 + koans-solved/arrays.lisp | 70 +++++ koans-solved/asserts.lisp | 65 +++++ koans-solved/atoms-vs-lists.lisp | 43 ++++ koans-solved/backquote.lisp | 65 +++++ koans-solved/basic-macros.lisp | 112 ++++++++ koans-solved/clos.lisp | 174 +++++++++++++ koans-solved/condition-handlers.lisp | 242 ++++++++++++++++++ koans-solved/control-statements.lisp | 68 +++++ koans-solved/dice-project.lisp | 91 +++++++ koans-solved/equality-distinctions.lisp | 121 +++++++++ koans-solved/evaluation.lisp | 66 +++++ koans-solved/extra-credit.lisp | 9 + koans-solved/extra-credit.txt | 66 +++++ koans-solved/format.lisp | 84 ++++++ koans-solved/functions.lisp | 184 +++++++++++++ koans-solved/hash-tables.lisp | 108 ++++++++ koans-solved/iteration.lisp | 75 ++++++ koans-solved/let.lisp | 62 +++++ koans-solved/lists.lisp | 146 +++++++++++ koans-solved/loops.lisp | 140 ++++++++++ koans-solved/macros.lisp | 116 +++++++++ koans-solved/mapcar-and-reduce.lisp | 97 +++++++ koans-solved/multiple-values.lisp | 41 +++ koans-solved/nil-false-empty.lisp | 52 ++++ koans-solved/scope-and-extent.lisp | 48 ++++ koans-solved/scoring-project.lisp | 82 ++++++ koans-solved/std-method-comb.lisp | 219 ++++++++++++++++ koans-solved/strings.lisp | 73 ++++++ koans-solved/structures.lisp | 111 ++++++++ koans-solved/threads.lisp | 161 ++++++++++++ koans-solved/triangle-project.lisp | 64 +++++ koans-solved/type-checking.lisp | 152 +++++++++++ .../variables-parameters-constants.lisp | 88 +++++++ koans-solved/vectors.lisp | 54 ++++ koans/arrays.lisp | 2 +- koans/basic-macros.lisp | 22 +- koans/evaluation.lisp | 2 +- koans/functions.lisp | 32 +-- koans/hash-tables.lisp | 16 +- koans/lists.lisp | 16 +- koans/scope-and-extent.lisp | 4 +- koans/structures.lisp | 13 +- lisp-koans.lisp | 30 +-- test-framework.lisp | 4 +- test.lisp | 29 +++ 47 files changed, 3461 insertions(+), 70 deletions(-) create mode 100644 koans-solved/arrays.lisp create mode 100644 koans-solved/asserts.lisp create mode 100644 koans-solved/atoms-vs-lists.lisp create mode 100644 koans-solved/backquote.lisp create mode 100644 koans-solved/basic-macros.lisp create mode 100644 koans-solved/clos.lisp create mode 100644 koans-solved/condition-handlers.lisp create mode 100644 koans-solved/control-statements.lisp create mode 100644 koans-solved/dice-project.lisp create mode 100644 koans-solved/equality-distinctions.lisp create mode 100644 koans-solved/evaluation.lisp create mode 100644 koans-solved/extra-credit.lisp create mode 100644 koans-solved/extra-credit.txt create mode 100644 koans-solved/format.lisp create mode 100644 koans-solved/functions.lisp create mode 100644 koans-solved/hash-tables.lisp create mode 100644 koans-solved/iteration.lisp create mode 100644 koans-solved/let.lisp create mode 100644 koans-solved/lists.lisp create mode 100644 koans-solved/loops.lisp create mode 100644 koans-solved/macros.lisp create mode 100644 koans-solved/mapcar-and-reduce.lisp create mode 100644 koans-solved/multiple-values.lisp create mode 100644 koans-solved/nil-false-empty.lisp create mode 100644 koans-solved/scope-and-extent.lisp create mode 100644 koans-solved/scoring-project.lisp create mode 100644 koans-solved/std-method-comb.lisp create mode 100644 koans-solved/strings.lisp create mode 100644 koans-solved/structures.lisp create mode 100644 koans-solved/threads.lisp create mode 100644 koans-solved/triangle-project.lisp create mode 100644 koans-solved/type-checking.lisp create mode 100644 koans-solved/variables-parameters-constants.lisp create mode 100644 koans-solved/vectors.lisp create mode 100644 test.lisp diff --git a/.koans b/.koans index 2ff700fa..89d6da5b 100644 --- a/.koans +++ b/.koans @@ -31,4 +31,4 @@ #:macros #+quicklisp #:threads #:extra-credit -) + ) diff --git a/README.md b/README.md index 974e06f3..14de9912 100644 --- a/README.md +++ b/README.md @@ -71,6 +71,16 @@ in the blank (\_\_\_\_) with appropriate lisp code to make the assert pass. In order to test code, or evaluate tests interactively, students may copy and paste code into the lisp command line REPL. +### Testing + +To test the koans, execute your lisp interpreter on the file 'contemplate.lisp' e.g. + + abcl --noinform --noinit --load test.lisp --eval '(quit)' + ccl -n -l test.lisp -e '(quit)' + clisp -q -norc -ansi test.lisp + ecl -norc -load test.lisp -eval '(quit)' + sbcl --script test.lisp + ## Quoting the Ruby Koans instructions "In test-driven development the mantra has always been, red, green, diff --git a/koans-solved/arrays.lisp b/koans-solved/arrays.lisp new file mode 100644 index 00000000..57d1c256 --- /dev/null +++ b/koans-solved/arrays.lisp @@ -0,0 +1,70 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +(define-test basic-array-stuff + ;; We make an 8x8 array and then fill it with a checkerboard pattern. + (let ((chess-board (make-array '(8 8)))) + ;; (DOTIMES (X 8) ...) will iterate with X taking values from 0 to 7. + (dotimes (x 8) + (dotimes (y 8) + ;; AREF stands for "array reference". + (setf (aref chess-board x y) (if (evenp (+ x y)) :black :white)))) + (assert-true (typep chess-board 'array)) + (assert-equal :black (aref chess-board 0 0)) + (assert-equal :white (aref chess-board 2 3)) + ;; The function ARRAY-RANK returns the number of dimensions of the array. + (assert-equal 2 (array-rank chess-board)) + ;; The function ARRAY-DIMENSIONS returns a list of the cardinality of the + ;; array dimensions. + (assert-equal '(8 8) (array-dimensions chess-board)) + ;; ARRAY-TOTAL-SIZE returns the total number of elements in the array. + (assert-equal 64 (array-total-size chess-board)))) + +(define-test make-your-own-array + ;; Make your own array that satisfies the test. + (let ((color-cube (make-array '(3 3 3)))) + ;; You may need to modify your array after you create it. + (setf (aref color-cube 0 1 2) :red + (aref color-cube 2 1 0) :white) + (if (typep color-cube '(simple-array T (3 3 3))) + (progn + (assert-equal 3 (array-rank color-cube)) + (assert-equal '(3 3 3) (array-dimensions color-cube)) + (assert-equal 27 (array-total-size color-cube)) + (assert-equal (aref color-cube 0 1 2) :red) + (assert-equal (aref color-cube 2 1 0) :white)) + (assert-true nil)))) + +(define-test adjustable-array + ;; The size of an array does not need to be constant. + (let ((x (make-array '(2 2) :initial-element 5 :adjustable t))) + (assert-equal 5 (aref x 1 0)) + (assert-equal '(2 2) (array-dimensions x)) + (adjust-array x '(3 4)) + (assert-equal '(3 4) (array-dimensions x)))) + +(define-test make-array-from-list + ;; One can create arrays with initial contents. + (let ((x (make-array '(4) :initial-contents '(:one :two :three :four)))) + (assert-equal '(4) (array-dimensions x)) + (assert-equal :one (aref x 0)))) + +(define-test row-major-index + ;; Row major indexing is a way to access elements with a single integer, + ;; rather than a list of integers. + (let ((my-array (make-array '(2 2 2 2)))) + (dotimes (i (* 2 2 2 2)) + (setf (row-major-aref my-array i) i)) + (assert-equal 0 (aref my-array 0 0 0 0)) + (assert-equal 15 (aref my-array 1 1 1 1)))) diff --git a/koans-solved/asserts.lisp b/koans-solved/asserts.lisp new file mode 100644 index 00000000..d3a7f292 --- /dev/null +++ b/koans-solved/asserts.lisp @@ -0,0 +1,65 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; ╭╮ ╭╮ /////// +;;; ┃┃ ┃┃/////// +;;; ┃┃╭┳━━┳━━╮ ┃┃╭┳━━┳━━┳━╮╭━━╮ +;;; ┃┃┣┫━━┫╭╮┃ ┃╰╯┫╭╮┃╭╮┃╭╮┫━━┫ +;;; ┃╰┫┣━━┃╰╯┃ ┃╭╮┫╰╯┃╭╮┃┃┃┣━━┃ +;;; ╰━┻┻━━┫╭━╯/╰╯╰┻━━┻╯╰┻╯╰┻━━╯ +;;; ┃┃ ////// +;;; ╰╯////// + +;;; Welcome to the Lisp Koans. +;;; May the code stored here influence your enlightenment as a programmer. + +;;; In order to progress, fill in the blanks, denoted via ____ in source code. +;;; Sometimes, you will be asked to provide values that are equal to something. + +(define-test fill-in-the-blanks + (assert-equal 2 2) + (assert-equal 3.14 3.14) + (assert-equal "Hello World" "Hello World")) + +;;; Sometimes, you will be asked to say whether something is true or false, +;;; In Common Lisp, the canonical values for truth and falsehood are T and NIL. + +(define-test assert-true + (assert-true t)) + +(define-test assert-false + (assert-false nil)) + +(define-test true-or-false + (true-or-false? t (= 34 34)) + (true-or-false? nil (= 19 78))) + +;;; Since T and NIL are symbols, you can type them in lowercase or uppercase; +;;; by default, Common Lisp will automatically upcase them upon reading. + +(define-test upcase-downcase + ;; Try inserting a lowercase t here. + (assert-equal t T) + ;; Try inserting an uppercase NIL here. + (assert-equal NIL nil)) + +;;; Sometimes, you will be asked to provide a part of an expression that must be +;;; either true or false. + +(define-test a-true-assertion + (assert-true (= 4 (+ 2 2)))) + +(define-test a-false-assertion + (assert-false (= 5 (+ 2 2)))) + diff --git a/koans-solved/atoms-vs-lists.lisp b/koans-solved/atoms-vs-lists.lisp new file mode 100644 index 00000000..ef1c2fe3 --- /dev/null +++ b/koans-solved/atoms-vs-lists.lisp @@ -0,0 +1,43 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; Lists in lisp are forms beginning and ending with rounded parentheses. +;;; Atoms are symbols, numbers, or other forms usually separated by whitespace +;;; or parentheses. + +(define-test list-or-atom + ;; The function LISTP will return true if the input is a list. + ;; The function ATOM will return true if the input is an atom. + (true-or-false? t (listp '(1 2 3))) + (true-or-false? nil (atom '(1 2 3))) + (true-or-false? t (listp '("heres" "some" "strings"))) + (true-or-false? nil (atom '("heres" "some" "strings"))) + (true-or-false? nil (listp "a string")) + (true-or-false? t (atom "a string")) + (true-or-false? nil (listp 2)) + (true-or-false? t (atom 2)) + (true-or-false? t (listp '(("first" "list") ("second" "list")))) + (true-or-false? nil (atom '(("first" "list") ("second" "list"))))) + +(define-test the-duality-of-nil + ;; The empty list, NIL, is unique in that it is both a list and an atom. + (true-or-false? t (listp nil)) + (true-or-false? t (atom nil))) + +(define-test keywords + ;; Symbols like :HELLO or :LIKE-THIS are keywords. They are treated + ;; differently in Lisp: they are constants that always evaluate to themselves. + (true-or-false? t (equal :this-is-a-keyword :this-is-a-keyword)) + (true-or-false? t (equal :this-is-a-keyword ':this-is-a-keyword)) + (true-or-false? nil (equal :this-is-a-keyword :this-is-also-a-keyword))) diff --git a/koans-solved/backquote.lisp b/koans-solved/backquote.lisp new file mode 100644 index 00000000..d8e15fdb --- /dev/null +++ b/koans-solved/backquote.lisp @@ -0,0 +1,65 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; Backquote notation is similar to quoting, except it allows for parts of the +;;; resulting expression to be "unquoted". + +(define-test backquote-basics + (let ((x '(123)) + (z '(7 8 9))) + ;; ' quotes an expression normally. + (assert-equal ____ '(x 45 6 z)) + ;; ` backquotes an expression; without any unquotes, it is equivalent to + ;; using the normal quote. + (assert-equal ____ `(x 45 6 z)) + ;; , unquotes a part of the expression. + (assert-equal ____ `(,x 45 6 z)) + (assert-equal ____ `(,x 45 6 ,z)) + ;; ,@ splices an expression into the into the list surrounding it. + (assert-equal ____ `(,x 45 6 ,@z)) + (assert-equal ____ `(,@x 45 6 ,@z)))) + +(define-test backquote-forms + ;; Because of its properties, backquote is useful for constructing Lisp forms + ;; that are macroexpansions or parts of macroexpansions. + (let ((variable 'x)) + ;; Fill in the blank without without using backquote/unquote notation. + (assert-equal ____ + `(if (typep ,variable 'string) + (format nil "The value of ~A is ~A" ',variable ,variable) + (error 'type-error :datum ,variable + :expected-type 'string)))) + (let ((error-type 'type-error) + (error-arguments '(:datum x :expected-type 'string))) + ;; Fill in the blank without without using backquote/unquote notation. + (assert-equal ____ + `(if (typep x 'string) + (format nil "The value of ~A is ~A" 'x x) + (error ',error-type ,@error-arguments))))) + +(define-test numbers-and-words + (let ((number 5) + (word 'dolphin)) + (true-or-false? ____ (equal '(1 3 5) `(1 3 5))) + (true-or-false? ____ (equal '(1 3 5) `(1 3 number))) + (assert-equal _____ `(1 3 ,number)) + (assert-equal _____ `(word ,word ,word word)))) + +(define-test splicing + (let ((axis '(x y z))) + (assert-equal '(the axis are ____) `(the axis are ,axis)) + (assert-equal '(the axis are ____) `(the axis are ,@axis))) + (let ((coordinates '((43.15 77.6) (42.36 71.06)))) + (assert-equal ____ `(the coordinates are ,coordinates)) + (assert-equal ____ `(the coordinates are ,@coordinates)))) diff --git a/koans-solved/basic-macros.lisp b/koans-solved/basic-macros.lisp new file mode 100644 index 00000000..dc6caba7 --- /dev/null +++ b/koans-solved/basic-macros.lisp @@ -0,0 +1,112 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +(define-test setf + ;; SETF is a macro used to assign values to places. A place is a concept; + ;; it is an abstract "somewhere" where a value is stored. + (let ((a 10) + (b (list 1 20 30 40 50)) + ;; We use COPY-SEQ to create a copy of a string, because using SETF to + ;; modify literal data (strings, lists, etc.) is undefined behaviour. + (c (copy-seq "I am Tom."))) + ;; A place may be a variable. + (setf a 1000) + (assert-equal 1000 a) + ;; A place may be a part of some list. + (setf (first b) 10) + (assert-equal '(10 20 30 40 50) b) + ;; A place may be a character in a string. + ;; The #\x syntax denotes a single character, 'x'. + (setf (char c 5) #\B + (char c 7) #\b) + (assert-equal "I am Bob." c) + ;; There are other kinds of places that we will explore in the future. + )) + +(define-test case + ;; CASE is a simple pattern-matching macro, not unlike C's "switch". + ;; It compares an input against a set of values and evaluates the code for + ;; the branch where a match is found. + (let* ((a 4) + (b (case a + (3 :three) + (4 :four) + (5 :five)))) + (assert-equal :four b)) + ;; CASE can accept a group of keys. + (let* ((c 4) + (d (case c + ((0 2 4 6 8) :even-digit) + ((1 3 5 7 9) :odd-digit)))) + (assert-equal :even-digit d))) + +(defun match-special-cases (thing) + ;; T or OTHERWISE passed as the key matches any value. + ;; NIL passed as the key matches no values. + ;; These symbols need to passed in parentheses. + (case thing + ((t) :found-a-t) + ((nil) :found-a-nil) + (t :something-else))) + +(define-test special-cases-of-case + ;; You need to fill in the blanks in MATCH-SPECIAL-CASES. + (assert-equal :found-a-t (match-special-cases t)) + (assert-equal :found-a-nil (match-special-cases nil)) + (assert-equal :something-else (match-special-cases 42))) + +(define-test your-own-case-statement + ;; We use FLET to define a local function. + (flet ((cartoon-dads (input) + (case input + ;; Fill in the blanks with proper cases. + (:bart :homer) + (:stewie :peter) + (:stan :randy) + (:this-one-doesnt-happen :fancy-cat) + (t :unknown)))) + (assert-equal (cartoon-dads :bart) :homer) + (assert-equal (cartoon-dads :stewie) :peter) + (assert-equal (cartoon-dads :stan) :randy) + (assert-equal (cartoon-dads :space-ghost) :unknown))) + +(define-test limits-of-case + ;; So far, we have been comparing objects using EQUAL, one of the Lisp + ;; comparison functions. CASE compares the keys using EQL, which is distinct + ;; from EQUAL. + ;; EQL is suitable for comparing numbers, characters, and objects for whom we + ;; want to check verify they are the same object. + (let* ((string "A string") + (string-copy (copy-seq string))) + ;; The above means that two distinct strings will not be the same under EQL, + ;; even if they have the same contents. + (true-or-false? nil (eql string string-copy)) + (true-or-false? t (equal string string-copy)) + ;; The above also means that CASE might give surprising results when used on + ;; strings. + (let ((match (case string + ("A string" :matched) + (t :not-matched)))) + (assert-equal :not-matched match)) + ;; We will explore this topic further in the EQUALITY-DISTINCTIONS lesson. + )) + +(define-test cond + ;; COND is similar to CASE, except it is more general. It accepts arbitrary + ;; conditions and checks them in order until one of them is met. + (let* ((number 4) + (result (cond ((> number 0) :positive) + ((< number 0) :negative) + (t :zero)))) + (assert-equal :positive result))) diff --git a/koans-solved/clos.lisp b/koans-solved/clos.lisp new file mode 100644 index 00000000..2429352e --- /dev/null +++ b/koans-solved/clos.lisp @@ -0,0 +1,174 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; CLOS is a shorthand for Common Lisp Object System. + +(defclass racecar () + ;; A class definition lists all the slots of every instance. + (color speed)) + +(define-test defclass + ;; Class instances are constructed via MAKE-INSTANCE. + (let ((car-1 (make-instance 'racecar)) + (car-2 (make-instance 'racecar))) + ;; Slot values can be set via SLOT-VALUE. + (setf (slot-value car-1 'color) :red) + (setf (slot-value car-1 'speed) 220) + (setf (slot-value car-2 'color) :blue) + (setf (slot-value car-2 'speed) 240) + (assert-equal ____ (slot-value car-1 'color)) + (assert-equal ____ (slot-value car-2 'speed)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass spaceship () + ;; It is possible to define reader, writer, and accessor functions for slots. + ((color :reader color :writer (setf color)) + (speed :accessor color))) + +;;; Specifying a reader function named COLOR is equivalent to +;;; (DEFMETHOD COLOR ((OBJECT SPACECSHIP)) ...) +;;; Specifying a writer function named (SETF COLOR) is equivalent to +;;; (DEFMETHOD (SETF COLOR) (NEW-VALUE (OBJECT SPACECSHIP)) ...) +;;; Specifying an accessor function performs both of the above. + +(define-test accessors + (let ((ship (make-instance 'spaceship))) + (setf (color ship) :orange + (speed ship) 1000) + (assert-equal ____ (color ship)) + (assert-equal ____ (speed ship)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass bike () + ;; It is also possible to define initial arguments for slots. + ((color :reader color :initarg :color) + (speed :reader color :initarg :color))) + +(define-test initargs + (let ((bike (make-instance 'bike :color :blue :speed 30))) + (assert-equal ____ (color bike)) + (assert-equal ____ (speed bike)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Lisp classes can inherit from one another. + +(defclass person () + ((name :initarg :name :accessor person-name))) + +(defclass lisp-programmer (person) + ((favorite-lisp-implementation :initarg :favorite-lisp-implementation + :accessor favorite-lisp-implementation))) + +(defclass c-programmer (person) + ((favorite-c-compiler :initarg :favorite-c-compiler + :accessor favorite-c-compiler))) + +(define-test inheritance + (let ((jack (make-instance 'person :name :jack)) + (bob (make-instance 'lisp-programmer + :name :bob + :favorite-lisp-implementation :sbcl)) + (adam (make-instance 'c-programmer + :name :adam + :favorite-c-compiler :llvm))) + (assert-equal ____ (person-name jack)) + (assert-equal ____ (person-name bob)) + (assert-equal ____ (favorite-lisp-implementation bob)) + (assert-equal ____ (person-name adam)) + (assert-equal ____ (favorite-c-compiler adam)) + (true-or-false? ____ (typep bob 'person)) + (true-or-false? ____ (typep bob 'lisp-programmer)) + (true-or-false? ____ (typep bob 'c-programmer)))) + +;;; This includes multiple inheritance. + +(defclass clisp-programmer (lisp-programmer c-programmer) ()) + +(define-test multiple-inheritance + (let ((zenon (make-instance 'clisp-programmer + :name :zenon + :favorite-lisp-implementation :clisp + :favorite-c-compiler :gcc))) + (assert-equal ____ (person-name zenon)) + (assert-equal ____ (favorite-lisp-implementation zenon)) + (assert-equal ____ (favorite-c-compiler zenon)) + (true-or-false? ____ (typep zenon 'person)) + (true-or-false? ____ (typep zenon 'lisp-programmer)) + (true-or-false? ____ (typep zenon 'c-programmer)) + (true-or-false? ____ (typep zenon 'embeddable-common-lisp-programmer)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Multiple inheritance makes it possible to work with mixin classes. + +(defclass greeting-mixin () + ((greeted-people :accessor greeted-people :initform '()))) + +(defgeneric greet (greeter greetee)) + +(defmethod greet ((object greeting-mixin) name) + ;; PUSHNEW is similar to PUSH, but it does not modify the place if the object + ;; we want to push is already found on the list in the place. + (pushnew name (greeted-people object) :test #'equal) + (format nil "Hello, ~A." name)) + +(defclass chatbot () + ((version :reader version :initarg :version))) + +(defclass greeting-chatbot (greeting-mixin chatbot) ()) + +(define-test greeting-chatbot () + (let ((chatbot (make-instance 'greeting-chatbot :version "1.0.0"))) + (true-or-false? ____ (typep chatbot 'greeting-mixin)) + (true-or-false? ____ (typep chatbot 'chatbot)) + (true-or-false? ____ (typep chatbot 'greeting-chatbot)) + (assert-equal ____ (greet chatbot "Tom")) + (assert-equal ____ (greeted-people chatbot)) + (assert-equal ____ (greet chatbot "Sue")) + (assert-equal ____ (greet chatbot "Mark")) + (assert-equal ____ (greet chatbot "Kate")) + (assert-equal ____ (greet chatbot "Mark")) + (assert-equal ____ (greeted-people chatbot)) + (assert-equal ____ (version chatbot)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass american (person) ()) + +(defclass italian (person) ()) + +(defgeneric stereotypical-food (person) + ;; The :METHOD option in DEFGENERIC is an alternative to DEFMETHOD. + (:method ((person italian)) :pasta) + (:method ((person american)) :burger)) + +;;; When methods or slot definitions of superclasses overlap with each other, +;;; the order of superclasses is used to resolve the conflict. + +(defclass stereotypical-person (american italian) ()) + +(defclass another-stereotypical-person (italian american) ()) + +(define-test stereotypes + (let ((james (make-instance 'american)) + (antonio (make-instance 'italian)) + (roy (make-instance 'stereotypical-person)) + (mary (make-instance 'another-stereotypical-person))) + (assert-equal ____ (stereotypical-food james)) + (assert-equal ____ (stereotypical-food antonio)) + (assert-equal ____ (stereotypical-food roy)) + (assert-equal ____ (stereotypical-food mary)))) diff --git a/koans-solved/condition-handlers.lisp b/koans-solved/condition-handlers.lisp new file mode 100644 index 00000000..24ae56a1 --- /dev/null +++ b/koans-solved/condition-handlers.lisp @@ -0,0 +1,242 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; Lisp condition types are very similar to classes. The standard specifies +;;; multiple standard condition types: among them, CONDITION, WARNING, +;;; SERIOUS-CONDITION, and ERROR. + +;;; The type CONDITION is the base type of all condition objects. + +(define-condition my-condition () ()) + +;;; The type WARNING is the base type of all conditions of which the programmer +;;; should be warned, unless the condition is somehow handled by the program. + +(define-condition my-warning (warning) ()) + +;;; The type SERIOUS-CONDITION includes programming errors and other situations +;;; where computation cannot proceed (e.g. due to memory or storage issues). + +(define-condition my-serious-condition (serious-condition) ()) + +;;; The type ERROR is the base type for all error situations in code. + +(define-condition my-error (error) ()) + +(define-test type-hierarchy + ;; Inheritance for condition types works the same way as for classes. + (let ((condition (make-condition 'my-condition))) + (true-or-false? ____ (typep condition 'my-condition)) + (true-or-false? ____ (typep condition 'condition)) + (true-or-false? ____ (typep condition 'warning)) + (true-or-false? ____ (typep condition 'error))) + (let ((condition (make-condition 'my-warning))) + (true-or-false? ____ (typep condition 'my-warning)) + (true-or-false? ____ (typep condition 'warning)) + (true-or-false? ____ (typep condition 'error))) + (let ((condition (make-condition 'my-serious-condition))) + (true-or-false? ____ (typep condition 'my-serious-condition)) + (true-or-false? ____ (typep condition 'serious-condition)) + (true-or-false? ____ (typep condition 'warning)) + (true-or-false? ____ (typep condition 'error))) + (let ((condition (make-condition 'my-error))) + (true-or-false? ____ (typep condition 'my-error)) + (true-or-false? ____ (typep condition 'my-serious-condition)) + (true-or-false? ____ (typep condition 'serious-condition)) + (true-or-false? ____ (typep condition 'warning)) + (true-or-false? ____ (typep condition 'error)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; A condition handler is composed of a handler function that accepts a +;;; condition object and a condition type for which the function will be called. + +(defvar *list*) + +(defun handle-my-error (condition) + (declare (ignore condition)) + (push :my-error *list*)) + +(defun handle-error (condition) + (declare (ignore condition)) + (push :error *list*)) + +(defun handle-my-serious-condition (condition) + (declare (ignore condition)) + (push :my-serious-condition *list*)) + +(define-test handler-bind + ;; When a condition is signaled, all handlers whose type matches the + ;; condition's type are allowed to execute. + (let ((*list* '())) + (handler-bind ((my-error #'handle-my-error) + (error #'handle-error) + (my-serious-condition #'handle-my-serious-condition)) + (signal (make-condition 'my-error))) + (assert-equal ____ *list*))) + +(define-test handler-order + ;; The order of binding handlers matters. + (let ((*list* '())) + (handler-bind ((error #'handle-error) + (my-error #'handle-my-error) + (my-serious-condition #'handle-my-serious-condition)) + (signal (make-condition 'my-error))) + (assert-equal ____ *list*))) + +(define-test multiple-handler-binds + ;; It is possible to bind handlers in steps. + (let ((*list* '())) + (handler-bind ((error #'handle-error) + (my-serious-condition #'handle-my-serious-condition)) + (handler-bind ((my-error #'handle-my-error)) + (signal (make-condition 'my-error)))) + (assert-equal ____ *list*))) + +(define-test same-handler + ;; The same handler may be bound multiple times. + (let ((*list* '())) + (handler-bind ((error #'handle-error) + (error #'handle-error)) + (handler-bind ((my-error #'handle-my-error) + (error #'handle-error) + (my-error #'handle-my-error)) + (signal (make-condition 'my-error)))) + (assert-equal ____ *list*))) + +(define-test handler-types + ;; A handler is not executed if it does not match the condition type. + (let ((*list* '())) + (handler-bind ((error #'handle-error) + (my-error #'handle-my-error) + (my-serious-condition #'handle-my-serious-condition)) + (signal (make-condition 'my-serious-condition))) + (assert-equal ____ *list*))) + +(define-test handler-transfer-of-control + ;; A handler may decline to handle the condition if it returns normally, + ;; or it may handle the condition by transferring control elsewhere. + (let ((*list* '())) + (block my-block + (handler-bind ((error #'handle-error) + (error (lambda (condition) + (declare (ignore condition)) + (return-from my-block))) + (error #'handle-error)) + (signal (make-condition 'my-error)))) + (assert-equal ____ *list*))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-test handler-case + ;; HANDLER-CASE always transfers control before executing the case forms. + (let ((*list* '())) + (handler-case (signal (make-condition 'my-error)) + (error (condition) (handle-error condition)) + (my-error (condition) (handle-my-error condition))) + (assert-equal ____ *list*))) + +(define-test handler-case-order + ;; The order of handler cases matters. + (let ((*list* '())) + (handler-case (signal (make-condition 'my-error)) + (my-error (condition) (handle-my-error condition)) + (error (condition) (handle-error condition))) + (assert-equal ____ *list*))) + +(define-test handler-case-type + ;; A handler cases is not executed if it does not match the condition type. + (let ((*list* '())) + (handler-case (signal (make-condition 'error)) + (my-error (condition) (handle-my-error condition)) + (error (condition) (handle-error condition))) + (assert-equal ____ *list*))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun divide (numerator denominator) + (/ numerator denominator)) + +(define-test error-signaling + ;; ASSERT-ERROR is a Lisp Koans macro which verifies that the correct error + ;; type is signaled. + (assert-equal 3 (divide 6 2)) + (assert-error 'division-by-zero (divide 6 0)) + (assert-error 'type-error (divide 6 :zero))) + +(define-test error-signaling-handler-case + (flet ((try-to-divide (numerator denominator) + ;; In code outside Lisp Koans, HANDLER-CASE should be used. + (handler-case (divide numerator denominator) + (division-by-zero () :division-by-zero) + (type-error () :type-error)))) + (assert-equal ____ (try-to-divide 6 2)) + (assert-equal ____ (try-to-divide 6 0)) + (assert-equal ____ (try-to-divide 6 :zero)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Condition objects can contain metadata about the specific situation that +;;; occurred in the code. + +(define-test accessors-division-by-zero + (let ((condition (handler-case (divide 6 0) (division-by-zero (c) c)))) + (assert-equal ____ (arithmetic-error-operands condition)) + (let ((operation (arithmetic-error-operation condition))) + (assert-equal ____ (funcall operation 12 4))))) + +(define-test accessors-type-error + (let ((condition (handler-case (divide 6 :zero) (type-error (c) c)))) + (assert-equal ____ (type-error-datum condition)) + (let ((expected-type (type-error-expected-type condition))) + (true-or-false? ____ (typep :zero expected-type)) + (true-or-false? ____ (typep 0 expected-type)) + (true-or-false? ____ (typep "zero" expected-type)) + (true-or-false? ____ (typep 0.0 expected-type))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; We can define slots in our own condition types in a way that is similar to +;; DEFCLASS. + +(define-condition parse-log-line-error (parse-error) + ((line :initarg :line :reader line) + (reason :initarg :reason :reader reason))) + +(defun log-line-type (line) + ;; The macro CHECK-TYPE signals a TYPE-ERROR if the object is not of the + ;; specified type. + (check-type line string) + (cond ((= 0 (search "TIMESTAMP" line)) :timestamp) + ((= 0 (search "HTTP" line)) :http) + ((= 0 (search "LOGIN" line)) :login) + ;; The function ERROR should be used for signaling serious conditions + ;; and errors: if the condition is not handled, it halts program + ;; execution and starts the Lisp debugger. + (t (error 'parse-log-line-error :line line + :reason :unknown-log-line-type)))) + +(define-test log-line-type-errors + (flet ((try-log-line-type (line) + (handler-case (log-line-type line) + (error (condition) condition)))) + (assert-equal ____ (try-log-line-type "TIMESTAMP 2020-05-08 16:59:39")) + (assert-equal ____ (try-log-line-type "HTTP GET / from 127.0.0.1")) + (assert-equal ____ (try-log-line-type "LOGIN administrator:hunter2")) + (let ((condition (try-log-line-type "WARNING: 95% of disk space used"))) + (assert-equal ____ (line condition)) + (assert-equal ____ (reason condition))) + (let ((condition (try-log-line-type 5555))) + (assert-equal 'string (____ condition)) + (assert-equal 5555 (____ condition))))) diff --git a/koans-solved/control-statements.lisp b/koans-solved/control-statements.lisp new file mode 100644 index 00000000..a5952854 --- /dev/null +++ b/koans-solved/control-statements.lisp @@ -0,0 +1,68 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +(define-test if + ;; IF only evaluates and returns one branch of a conditional expression. + (assert-equal ____ (if t :true :false)) + (assert-equal ____ (if nil :true :false)) + ;; This also applies to side effects that migh or might not be evaluated. + (let ((result)) + (if t + (setf result :true) + (setf result :false)) + (assert-equal ____ result) + (if nil + (setf result :true) + (setf result :false)) + (assert-equal ____ result))) + +(define-test when-unless + ;; WHEN and UNLESS are like one-branched IF statements. + (let ((when-result nil) + (when-numbers '()) + (unless-result nil) + (unless-numbers '())) + (dolist (x '(1 2 3 4 5 6 7 8 9 10)) + (when (> x 5) + (setf when-result x) + (push x when-numbers)) + (unless (> x 5) + (setf unless-result x) + (push x unless-numbers))) + (assert-equal ____ when-result) + (assert-equal ____ when-numbers) + (assert-equal ____ unless-result) + (assert-equal ____ unless-numbers))) + +(define-test and-short-circuit + ;; AND only evaluates forms until one evaluates to NIL. + (assert-equal ____ + (let ((x 0)) + (and + (setf x (+ 1 x)) + (setf x (+ 1 x)) + nil + (setf x (+ 1 x))) + x))) + +(define-test or-short-circuit + ;; AND only evaluates forms until one evaluates to non-NIL. + (assert-equal ____ + (let ((x 0)) + (or + (setf x (+ 1 x)) + (setf x (+ 1 x)) + nil + (setf x (+ 1 x))) + x))) diff --git a/koans-solved/dice-project.lisp b/koans-solved/dice-project.lisp new file mode 100644 index 00000000..e9a4a3d6 --- /dev/null +++ b/koans-solved/dice-project.lisp @@ -0,0 +1,91 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; In this project, we are going to define a CLOS class representing a simple +;;; set of dice. There are only two operations on the dice: reading the dice +;;; values and re-rolling their values. + +(defclass dice-set () + ;; Fill in the blank with a proper slot definition. + (____)) + +(defmethod dice-values ((object dice-set)) + ____) + +(defmethod roll ((count integer) (object dice-set)) + ____) + +(define-test make-dice-set + (let ((dice (make-instance 'dice-set))) + (assert-true (type-of dice 'dice-set)))) + +(define-test dice-are-six-sided + (let ((dice (make-instance 'dice-set))) + (roll 5 dice) + (assert-true (typep (dice-values dice) 'list)) + (assert-equal 5 (length (dice-values dice))) + (dolist (die (dice-values dice)) + (assert-true (typep die '(integer 1 6)))))) + +(define-test dice-values-do-not-change-without-rolling + (let ((dice (make-instance 'dice-set))) + (roll 100 dice) + (let ((dice-values-1 (dice-values dice)) + (dice-values-2 (dice-values dice))) + (assert-equal dice-values-1 dice-values-2)))) + +(define-test roll-returns-new-dice-values + (let* ((dice (make-instance 'dice-set)) + (dice-values (roll 100 dice))) + (assert-true (equal dice-values (dice-values dice))))) + +(define-test dice-values-should-change-between-rolling + (let* ((dice (make-instance 'dice-set)) + (first-time (roll 100 dice)) + (second-time (roll 100 dice))) + (assert-false (equal first-time second-time)) + (assert-true (equal second-time (dice-values dice))))) + +(define-test different-dice-sets-have-different-values + (let* ((dice-1 (make-instance 'dice-set)) + (dice-2 (make-instance 'dice-set))) + (roll 100 dice-1) + (roll 100 dice-2) + (assert-false (equal (dice-values dice-1) (dice-values dice-2))))) + +(define-test different-numbers-of-dice + (let ((dice (make-instance 'dice-set))) + (assert-equal 5 (length (roll 5 dice))) + (assert-equal 100 (length (roll 100 dice))) + (assert-equal 1 (length (roll 1 dice))))) + +(define-test junk-as-dice-count + (let ((dice (make-instance 'dice-set))) + (labels ((dice-failure (count) + (handler-case (progn (roll-dice count dice) + (error "Test failure")) + (error (condition) condition))) + (test-dice-failure (value) + (let* ((condition (dice-failure value)) + (expected-type (type-error-expected-type condition))) + (assert-true (typep condition 'type-error)) + (assert-equal value (type-error-datum)) + (assert-true (subtypep expected-type '(integer 1 6))) + (assert-true (subtypep '(integer 1 6) expected-type))))) + (test-dice-failure 0) + (test-dice-failure "0") + (test-dice-failure :zero) + (test-dice-failure 18.0) + (test-dice-failure -7) + (test-dice-failure '(6 6 6))))) diff --git a/koans-solved/equality-distinctions.lisp b/koans-solved/equality-distinctions.lisp new file mode 100644 index 00000000..becd7028 --- /dev/null +++ b/koans-solved/equality-distinctions.lisp @@ -0,0 +1,121 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; The most common equality predicates in Common Lisp are, in order of +;;; strictness, EQ, EQL, EQUAL, and EQUALP. + +(define-test eq + ;; EQ checks the identity of the two objects; it checks whether the two + ;; objects are, in fact, one and the same object. + ;; It is the fastest of the four; however, not guaranteed to work on numbers + ;; and characters because of that. + (true-or-false? t (eq 'a 'a)) + (true-or-false? nil (eq 3 3.0)) + (true-or-false? nil (eq '(1 2) '(1 2))) + (true-or-false? nil (eq "Foo" "Foo")) + (true-or-false? nil (eq "Foo" (copy-seq "Foo"))) + (true-or-false? nil (eq "FOO" "Foo"))) + +(define-test eql + ;; EQL works like EQ, except it is specified to work for numbers and + ;; characters. + ;; Two numbers are EQL if they are of the same type and represent the same + ;; number. Two characters are EQL if they represent the same character. + (true-or-false? t (eql 'a 'a)) + (true-or-false? t (eql 3 3)) + (true-or-false? nil (eql 3 3.0)) + (true-or-false? nil (eql '(1 2) '(1 2))) + (true-or-false? nil (eql '(:a . :b) '(:a . :b))) + (true-or-false? t (eql #\S #\S)) + (true-or-false? nil (eql "Foo" "Foo")) + (true-or-false? nil (eql "Foo" (copy-seq "Foo"))) + (true-or-false? nil (eql "FOO" "Foo"))) + +(define-test equal + ;; EQUAL works like EQL, except works differently for lists, strings, bit + ;; vectors, and pathnames. + ;; Two lists, strings, bit arrays, or pathnames are EQUAL if they have EQUAL + ;; elements. + (true-or-false? t (equal 'a 'a)) + (true-or-false? t (equal 3 3)) + (true-or-false? nil (equal 3 3.0)) + (true-or-false? t (equal '(1 2) '(1 2))) + (true-or-false? t (equal '(:a . :b) '(:a . :b))) + (true-or-false? nil (equal '(:a . :b) '(:a . :doesnt-match))) + (true-or-false? t (equal #\S #\S)) + (true-or-false? t (equal "Foo" "Foo")) + (true-or-false? t (equal #*01010101 #*01010101)) + (true-or-false? t (equal "Foo" (copy-seq "Foo"))) + (true-or-false? nil (equal "FOO" "Foo")) + (true-or-false? t (equal #p"foo/bar/baz" #p"foo/bar/baz"))) + +(defstruct thing slot-1 slot-2) + +(define-test equalp + ;; EQUALP works like EQUAL, except it works differently for characters, + ;; numbers, arrays, structures, and hash tables. + ;; Two characters are EQUALP if they represent the same character, ignoring + ;; the differences in character case. + ;; Two numbers are EQUALP if they represent the same number, even if they are + ;; of different types. + ;; Two arrays are EQUALP if they have the same dimensions and their characters + ;; are pairwise EQUALP. + ;; Two structures are EQUALP if they are of the same class and their slots are + ;; pairwise EQUALP. + ;; We will contemplate hash tables in the HASH-TABLES lesson. + (true-or-false? t (equalp 'a 'a)) + (true-or-false? t (equalp 3 3)) + (true-or-false? t (equalp 3 3.0)) + (true-or-false? t (equalp '(1 2) '(1 2))) + (true-or-false? t (equalp '(:a . :b) '(:a . :b))) + (true-or-false? nil (equalp '(:a . :b) '(:a . :doesnt-match))) + (true-or-false? t (equalp #\S #\S)) + (true-or-false? t (equalp "Foo" "Foo")) + (true-or-false? t (equalp "Foo" (copy-seq "Foo"))) + (true-or-false? t (equalp "FOO" "Foo")) + (true-or-false? t (equalp (make-array '(4 2) :initial-element 0) + (make-array '(4 2) :initial-element 0))) + (true-or-false? t (equalp (make-thing :slot-1 42 :slot-2 :forty-two) + (make-thing :slot-1 42 :slot-2 :forty-two)))) + +;;; In additional to the generic equality predicates, Lisp also provides +;;; type-specific predicates for numbers, strings, and characters. + +(define-test = + ;; The function = behaves just like EQUALP on numbers. + ;; #C(... ...) is syntax sugar for creating a complex number. + (true-or-false? t (= 99.0 99 99.000 #C(99 0) #C(99.0 0.0))) + (true-or-false? nil (= 0 1 -1)) + (true-or-false? t (= (/ 2 3) (/ 6 9) (/ 86 129)))) + +(define-test string= + ;; The function STRING= behaves just like EQUAL on strings. + ;; The function STRING-EQUAL behaves just like EQUALP on strings. + (true-or-false? t (string= "Foo" "Foo")) + (true-or-false? nil (string= "Foo" "FOO")) + (true-or-false? t (string-equal "Foo" "FOO")) + ;; These functions accept additional keyword arguments that allow one to + ;; only compare parts of the strings. + (true-or-false? t (string= "together" "frog" :start1 1 :end1 3 + :start2 2)) + (true-or-false? t (string-equal "together" "FROG" :start1 1 :end1 3 + :start2 2))) + +(define-test char= + ;; The function CHAR= behaves just like EQL on characters. + ;; The function CHAR-EQUAL behaves just like EQUALP on characters. + (true-or-false? t (char= #\A (char "ABCDEF" 0))) + (true-or-false? nil (char= #\A #\a)) + (true-or-false? t (char-equal #\A (char "ABCDEF" 0))) + (true-or-false? t (char-equal #\A #\a))) diff --git a/koans-solved/evaluation.lisp b/koans-solved/evaluation.lisp new file mode 100644 index 00000000..709f3e08 --- /dev/null +++ b/koans-solved/evaluation.lisp @@ -0,0 +1,66 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; In most imperative languages, the syntax of a function call has the function +;;; name succeeded by a list of arguments. In Lisp, the function name and +;;; arguments are all part of the same list, with the function name the first +;;; element of that list. + +(define-test function-names + ;; In these examples, +, -, *, and / are function names. + (assert-equal 5 (+ 2 3)) + (assert-equal -2 (- 1 3)) + (assert-equal 28 (* 7 4)) + (assert-equal 25 (/ 100 4))) + +(define-test numberp + ;; NUMBERP is a predicate which returns true if its argument is a number. + (assert-equal t (numberp 5)) + (assert-equal t (numberp 2.0)) + (assert-equal nil (numberp "five"))) + +(define-test evaluation-order + ;; Arguments to a function are evaluated before the function is called. + (assert-equal 9 (* (+ 1 2) (- 13 10)))) + +(define-test basic-comparisons + ;; The below functions are boolean functions (predicates) that operate on + ;; numbers. + (assert-equal t (> 25 4)) + (assert-equal nil (< 8 2)) + (assert-equal t (= 3 3)) + (assert-equal t (<= 6 (/ 12 2))) + (assert-equal t (>= 20 (+ 1 2 3 4 5))) + (assert-equal t (/= 15 (+ 4 10)))) + +(define-test quote + ;; Preceding a list with a quote (') will tell Lisp not to evaluate a list. + ;; The quote special form suppresses normal evaluation, and instead returns + ;; the literal list. + ;; Evaluating the form (+ 1 2) returns the number 3, but evaluating the form + ;; '(+ 1 2) returns the list (+ 1 2). + (assert-equal 3 (+ 1 2)) + (assert-equal '(+ 1 2) '(+ 1 2)) + (assert-equal '(+ 1 2) (list '+ 1 2)) + ;; The 'X syntax is syntactic sugar for (QUOTE X). + (true-or-false? t (equal '(/ 4 0) (quote (/ 4 0))))) + +(define-test listp + ;; LISTP is a predicate which returns true if the argument is a list. + (assert-equal t (listp '(1 2 3))) + (assert-equal nil (listp 100)) + (assert-equal nil (listp "Hello world")) + (assert-equal t (listp nil)) + (assert-equal nil (listp (+ 1 2))) + (assert-equal t (listp '(+ 1 2)))) diff --git a/koans-solved/extra-credit.lisp b/koans-solved/extra-credit.lisp new file mode 100644 index 00000000..0e4be3f4 --- /dev/null +++ b/koans-solved/extra-credit.lisp @@ -0,0 +1,9 @@ +;;; EXTRA CREDIT: +;;; +;;; Create a program that will play the Greed game. +;;; The full rules for the game are in the file extra-credit.txt. +;;; +;;; You already have a DICE-SET class and a score function you can use. +;;; Write a PLAYER class and a GAME class to complete the project. +;;; +;;; This is a free form assignment, so approach it however you desire. diff --git a/koans-solved/extra-credit.txt b/koans-solved/extra-credit.txt new file mode 100644 index 00000000..58b5a9cb --- /dev/null +++ b/koans-solved/extra-credit.txt @@ -0,0 +1,66 @@ += Playing Greed + +Greed is a dice game played among 2 or more players, using 5 +six-sided dice. + +== Playing Greed + +Each player takes a turn consisting of one or more rolls of the dice. +On the first roll of the game, a player rolls all five dice which are +scored according to the following: + + Three 1's => 1000 points + Three 6's => 600 points + Three 5's => 500 points + Three 4's => 400 points + Three 3's => 300 points + Three 2's => 200 points + One 1 => 100 points + One 5 => 50 points + +A single die can only be counted once in each roll. For example, +a "5" can only count as part of a triplet (contributing to the 500 +points) or as a single 50 points, but not both in the same roll. + +Example Scoring + + Throw Score + --------- ------------------ + 5 1 3 4 1 50 + 2 * 100 = 250 + 1 1 1 3 1 1000 + 100 = 1100 + 2 4 4 5 4 400 + 50 = 450 + +The dice not contributing to the score are called the non-scoring +dice. "3" and "4" are non-scoring dice in the first example. "3" is +a non-scoring die in the second, and "2" is a non-score die in the +final example. + +After a player rolls and the score is calculated, the scoring dice are +removed and the player has the option of rolling again using only the +non-scoring dice. If all of the thrown dice are scoring, then the +player may roll all 5 dice in the next roll. + +The player may continue to roll as long as each roll scores points. If +a roll has zero points, then the player loses not only their turn, but +also accumulated score for that turn. If a player decides to stop +rolling before rolling a zero-point roll, then the accumulated points +for the turn is added to his total score. + +== Getting "In The Game" + +Before a player is allowed to accumulate points, they must get at +least 300 points in a single turn. Once they have achieved 300 points +in a single turn, the points earned in that turn and each following +turn will be counted toward their total score. + +== End Game + +Once a player reaches 3000 (or more) points, the game enters the final +round where each of the other players gets one more turn. The winner +is the player with the highest score after the final round. + +== References + +Greed is described on Wikipedia at +http://en.wikipedia.org/wiki/Greed_(dice_game), however the rules are +a bit different from the rules given here. diff --git a/koans-solved/format.lisp b/koans-solved/format.lisp new file mode 100644 index 00000000..39d0e6fa --- /dev/null +++ b/koans-solved/format.lisp @@ -0,0 +1,84 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; The function FORMAT is used to create formatted output. It is similar to +;;; the C function printf(). +;;; See http://www.gigamonkeys.com/book/a-few-format-recipes.html + +;;; T as the first argument to FORMAT prints the string to standard output. +;;; NIL as the first argument to FORMAT causes it to return the string. + +(define-test format-basic + ;; If there are no format directives in the string, FORMAT will return + ;; a string that is STRING= to its format control. + (assert-equal ____ (format nil "Lorem ipsum dolor sit amet"))) + +(define-test format-aesthetic + ;; The ~A format directive creates aesthetic output. + (assert-equal ____ (format nil "This is the number ~A" 42)) + (assert-equal ____ (format nil "This is the keyword ~A" :foo)) + (assert-equal ____ (format nil "~A evaluates to ~A" + '(/ 24 (- 3 (/ 8 3))) + (/ 24 (- 3 (/ 8 3))))) + (assert-equal ____ (format nil "This is the character ~A" #\C)) + (assert-equal ____ (format nil "In a ~A" "galaxy far far away"))) + +(define-test format-standard + ;; The ~S format directive prints objects with escape characters. + ;; Not all Lisp objects require to be escaped. + (assert-equal ____ (format nil "This is the number ~S" 42)) + (assert-equal ____ (format nil "~S evaluates to ~S" + '(/ 24 (- 3 (/ 8 3))) + (/ 24 (- 3 (/ 8 3))))) + ;; Keywords are printed with their leading colon. + (assert-equal ____ (format nil "This is the keyword ~S" :foo)) + ;; Characters are printed in their #\X form. The backslash will need to be + ;; escaped inside the printed string, just like in "#\\X". + (assert-equal ____ (format nil "This is the character ~S" #\C)) + ;; Strings include quote characters, which must be escaped: + ;; such a string might look in code like "foo \"bar\"". + (assert-equal ____ (format nil "In a ~S" "galaxy far far away"))) + +(define-test format-radix + ;; The ~B, ~O, ~D, and ~X radices print numbers in binary, octal, decimal, and + ;; hexadecimal notation. + (assert-equal ____ (format nil "This is the number ~B" 42)) + (assert-equal ____ (format nil "This is the number ~O" 42)) + (assert-equal ____ (format nil "This is the number ~D" 42)) + (assert-equal ____ (format nil "This is the number ~X" 42)) + ;; We can specify a custom radix by using the ~R directive. + (assert-equal ____ (format nil "This is the number ~3R" 42)) + ;; It is possible to print whole forms this way. + (let ((form '(/ 24 (- 3 (/ 8 3)))) + (result (/ 24 (- 3 (/ 8 3))))) + (assert-equal ____ (format nil "~B evaluates to ~B" form result)) + (assert-equal ____ (format nil "~O evaluates to ~O" form result)) + (assert-equal ____ (format nil "~D evaluates to ~D" form result)) + (assert-equal ____ (format nil "~X evaluates to ~X" form result)) + (assert-equal ____ (format nil "~3R evaluates to ~3R" form result)))) + +(define-test format-iteration + ;; The ~{ and ~} directives iterate over a list. + (assert-equal ____ (format nil "~{[~A]~}" '(1 2 3 4 5 6))) + (assert-equal ____ (format nil "~{[~A ~A]~}" '(1 2 3 4 5 6))) + ;; The directive ~^ aborts iteration when no more elements remain. + (assert-equal ____ (format nil "~{[~A]~^, ~}" '(1 2 3 4 5 6)))) + +(define-test format-case + ;; The ~( and ~) directives adjust the string case. + (assert-equal ____ (format nil "~(~A~)" "The QuIcK BROWN fox")) + ;; Some FORMAT directives can be further adjusted with the : and @ modifiers. + (assert-equal ____ (format nil "~:(~A~)" "The QuIcK BROWN fox")) + (assert-equal ____ (format nil "~@(~A~)" "The QuIcK BROWN fox")) + (assert-equal ____ (format nil "~:@(~A~)" "The QuIcK BROWN fox"))) diff --git a/koans-solved/functions.lisp b/koans-solved/functions.lisp new file mode 100644 index 00000000..2b757aa9 --- /dev/null +++ b/koans-solved/functions.lisp @@ -0,0 +1,184 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +(defun some-named-function (a b) + (+ a b)) + +(define-test call-a-function + ;; DEFUN can be used to define global functions. + (assert-equal 9 (some-named-function 4 5)) + ;; FLET can be used to define local functions. + (flet ((another-named-function (a b) (* a b))) + (assert-equal 20 (another-named-function 4 5))) + ;; LABELS can be used to define local functions which can refer to themselves + ;; or each other. + (labels ((recursive-function (a b) + (if (or (= 0 a) (= 0 b)) + 1 + (+ (* a b) (recursive-function (1- a) (1- b)))))) + (assert-equal 41 (recursive-function 4 5)))) + +(define-test shadow-a-function + (assert-eq 18 (some-named-function 7 11)) + ;; FLET and LABELS can shadow function definitions. + (flet ((some-named-function (a b) (* a b))) + (assert-equal 77 (some-named-function 7 11))) + (assert-equal 18 (some-named-function 7 11))) + +(defun function-with-optional-parameters (&optional (a 2) (b 3) c) + ;; If an optional argument to a function is not provided, it is given its + ;; default value, or NIL, if no default value is specified. + (list a b c)) + +(define-test optional-parameters + (assert-equal '(42 24 4224) (function-with-optional-parameters 42 24 4224)) + (assert-equal '(42 24 nil) (function-with-optional-parameters 42 24)) + (assert-equal '(42 3 nil) (function-with-optional-parameters 42)) + (assert-equal '(2 3 nil) (function-with-optional-parameters))) + +(defun function-with-optional-indication + (&optional (a 2 a-provided-p) (b 3 b-provided-p)) + ;; It is possible to check whether an optional argument was provided. + (list a a-provided-p b b-provided-p)) + +(define-test optional-indication + (assert-equal '(42 t 24 t) (function-with-optional-indication 42 24)) + (assert-equal '(42 t 3 nil) (function-with-optional-indication 42)) + (assert-equal '(2 nil 3 nil) (function-with-optional-indication))) + +(defun function-with-rest-parameter (&rest x) + ;; A rest parameter gathers all remaining parameters in a list. + x) + +(define-test rest-parameter + (assert-equal '() (function-with-rest-parameter)) + (assert-equal '(1) (function-with-rest-parameter 1)) + (assert-equal '(1 :two 333) (function-with-rest-parameter 1 :two 333))) + +(defun function-with-keyword-parameters (&key (a :something) b c) + ;; A keyword parameters is similar to an optional parameter, but is provided + ;; by a keyword-value pair. + (list a b c)) + +(define-test keyword-parameters () + (assert-equal '(:something nil nil) (function-with-keyword-parameters)) + (assert-equal '(11 22 33) (function-with-keyword-parameters :a 11 :b 22 :c 33)) + ;; It is not necessary to specify all keyword parameters. + (assert-equal '(:something 22 nil) (function-with-keyword-parameters :b 22)) + ;; Keyword argument order is not important. + (assert-equal '(0 22 -5/2) + (function-with-keyword-parameters :b 22 :c -5/2 :a 0)) + ;; Lisp handles duplicate keyword parameters. + (assert-equal '(:something 22 nil) + (function-with-keyword-parameters :b 22 :b 40 :b 812))) + +(defun function-with-keyword-indication + (&key (a 2 a-provided-p) (b 3 b-provided-p)) + ;; It is possible to check whether a keyword argument was provided. + (list a a-provided-p b b-provided-p)) + +(define-test keyword-indication + (assert-equal '(2 nil 3 nil) (function-with-keyword-indication)) + (assert-equal '(3 t 4 t) (function-with-keyword-indication :a 3 :b 4)) + (assert-equal '(11 t 22 t) (function-with-keyword-indication :a 11 :b 22)) + (assert-equal '(2 nil 22 t) (function-with-keyword-indication :b 22)) + (assert-equal '(0 t 22 t) (function-with-keyword-indication :b 22 :a 0))) + +(defun function-with-funky-parameters (a &rest x &key b (c a c-provided-p)) + ;; Lisp functions can have surprisingly complex lambda lists. + ;; A &rest parameter must come before &key parameters. + (list a b c c-provided-p x)) + +(define-test funky-parameters + (assert-equal '(1 nil 1 nil nil) (function-with-funky-parameters 1)) + (assert-equal '(1 2 1 nil (:b 2)) (function-with-funky-parameters 1 :b 2)) + (assert-equal '(1 2 3 t (:b 2 :c 3)) + (function-with-funky-parameters 1 :b 2 :c 3)) + (assert-equal '(1 2 3 t (:c 3 :b 2)) + (function-with-funky-parameters 1 :c 3 :b 2))) + +(define-test lambda + ;; A list form starting with the symbol LAMBDA denotes an anonymous function. + ;; It is possible to call that function immediately or to store it for later + ;; use. + (let ((my-function (lambda (a b) (* a b)))) + (assert-equal 99 (funcall my-function 11 9))) + ;; A LAMBDA form is allowed to take the place of a function name. + (assert-equal 19 ((lambda (a b) (+ a b)) 10 9)) + (let ((functions (list (lambda (a b) (+ a b)) + (lambda (a b) (- a b)) + (lambda (a b) (* a b)) + (lambda (a b) (/ a b))))) + (assert-equal 35 (funcall (first functions) 2 33)) + (assert-equal -31 (funcall (second functions) 2 33)) + (assert-equal 66 (funcall (third functions) 2 33)) + (assert-equal 2/33 (funcall (fourth functions) 2 33)))) + +(define-test lambda-with-optional-parameters + (assert-equal 19 ((lambda (a &optional (b 100)) (+ a b)) 10 9)) + (assert-equal 110 ((lambda (a &optional (b 100)) (+ a b)) 10))) + +(defun make-adder (x) + ;; MAKE-ADDER will create a function that closes over the parameter X. + ;; The parameter will be remembered as a part of the environment of the + ;; returned function, which will continue refering to it. + (lambda (y) (+ x y))) + +(define-test lexical-closures + (let ((adder-100 (make-adder 100)) + (adder-500 (make-adder 500))) + ;; ADD-100 and ADD-500 now close over different values. + (assert-equal 103 (funcall adder-100 3)) + (assert-equal 503 (funcall adder-500 3)))) + +(defun make-reader-and-writer (x) + ;; Both returned functions will refer to the same place. + (list (function (lambda () x)) + (function (lambda (y) (setq x y))))) + +(define-test lexical-closure-interactions + ;; The macro DESTRUCTURING-BIND is like LET, except it binds the variables + ;; listed in its first argument to the parts of the list returned by the form + ;; that is its second argument. + (destructuring-bind (reader-1 writer-1) (make-reader-and-writer 1) + (destructuring-bind (reader-2 writer-2) (make-reader-and-writer :one) + (assert-equal 1 (funcall reader-1)) + (funcall writer-1 0) + (assert-equal 0 (funcall reader-1)) + ;; The two different function pairs refer to different places. + (assert-equal :one (funcall reader-2)) + (funcall writer-2 :zero) + (assert-equal :zero (funcall reader-2))))) + +(define-test apply + ;; The function APPLY applies a function to a list of arguments. + (let ((function (lambda (x y z) (+ x y z)))) + (assert-equal 123 (apply function '(100 20 3)))) + ;; FUNCTION is a special operator that retrieves function objects, defined + ;; both globally and locally. #'X is syntax sugar for (FUNCTION X). + (assert-equal 3 (apply (function +) '(1 2))) + (assert-equal -1 (apply #'- '(1 2))) + ;; Only the last argument to APPLY must be a list. + (assert-equal 6 (apply #'+ 1 2 '(3))) + (assert-equal 4 (apply #'max 1 2 3 4 '()))) + +(define-test funcall + ;; The function FUNCALL calls a function with arguments, not expecting a final + ;; list of arguments. + (let ((function (lambda (x y z) (+ x y z)))) + (assert-equal 321 (funcall function 300 20 1))) + (assert-equal 3 (funcall (function +) 1 2)) + (assert-equal -1 (funcall #'- 1 2)) + (assert-equal 6 (funcall #'+ 1 2 3)) + (assert-equal 4 (funcall #'max 1 2 3 4))) diff --git a/koans-solved/hash-tables.lisp b/koans-solved/hash-tables.lisp new file mode 100644 index 00000000..c0290b1e --- /dev/null +++ b/koans-solved/hash-tables.lisp @@ -0,0 +1,108 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; A hash table data structure is sometimes known as a dictionary. + +(define-test make-hash-table + (let ((my-hash-table (make-hash-table))) + (true-or-false? t (typep my-hash-table 'hash-table)) + (true-or-false? t (hash-table-p my-hash-table)) + (true-or-false? nil (hash-table-p (make-array '(3 3 3)))) + ;; The function HASH-TABLE-COUNT returns the number of entries currently + ;; contained in a hash table. + (assert-equal 0 (hash-table-count my-hash-table)))) + +(define-test gethash + ;; The function GETHASH can be used to access hash table values. + (let ((cube-roots (make-hash-table))) + ;; We add the key-value pair 1 - "uno" to the hash table. + (setf (gethash 1 cube-roots) "uno") + (assert-equal "uno" (gethash 1 cube-roots)) + (assert-equal 1 (hash-table-count cube-roots)) + (setf (gethash 8 cube-roots) 2) + (setf (gethash -3 cube-roots) -27) + (assert-equal -27 (gethash -3 cube-roots)) + (assert-equal 3 (hash-table-count cube-roots)) + ;; GETHASH returns a secondary value that is true if the key was found in + ;; the hash-table and false otherwise. + (multiple-value-bind (value foundp) (gethash 8 cube-roots) + (assert-equal 2 value) + (assert-equal t foundp)) + (multiple-value-bind (value foundp) (gethash 125 cube-roots) + (assert-equal nil value) + (assert-equal nil foundp)))) + +(define-test hash-table-test + ;; A hash table can be constructed with different test predicates. + ;; The programmer may choose between EQ, EQL, EQUAL, and EQUALP to get the + ;; best performance and expected results from the hash table. + ;; The default test predicate is EQL. + (let ((eq-table (make-hash-table :test #'eq)) + (eql-table (make-hash-table)) + (equal-table (make-hash-table :test #'equal)) + (equalp-table (make-hash-table :test #'equalp))) + ;; We will define four variables whose values are strings. + (let* ((string "one") + (same-string string) + (string-copy (copy-seq string)) + (string-upcased "ONE")) + ;; We will insert the value of each variable into each hash table. + (dolist (thing (list string same-string string-copy string-upcased)) + (dolist (hash-table (list eq-table eql-table equal-table equalp-table)) + (setf (gethash thing hash-table) t)))) + ;; How many entries does each hash table contain? + (assert-equal 3 (hash-table-count eq-table)) + (assert-equal 3 (hash-table-count eql-table)) + (assert-equal 2 (hash-table-count equal-table)) + (assert-equal 1 (hash-table-count equalp-table)))) + +(define-test hash-table-equality + ;; EQUALP considers two hash tables to be equal if they have the same test and + ;; if its key-value pairs are the same under that test. + (let ((hash-table-1 (make-hash-table :test #'equal)) + (hash-table-2 (make-hash-table :test #'equal))) + (setf (gethash "one" hash-table-1) "yat") + (setf (gethash "one" hash-table-2) "yat") + (setf (gethash "two" hash-table-1) "yi") + (setf (gethash "two" hash-table-2) "yi") + (true-or-false? nil (eq hash-table-1 hash-table-2)) + (true-or-false? nil (equal hash-table-1 hash-table-2)) + (true-or-false? t (equalp hash-table-1 hash-table-2)))) + +(define-test i-will-make-it-equalp + (let ((hash-table-1 (make-hash-table :test #'equal)) + (hash-table-2 (make-hash-table :test #'equal))) + (setf (gethash "one" hash-table-1) "uno" + (gethash "two" hash-table-1) "dos") + (setf (gethash "one" hash-table-2) "eins" + (gethash "two" hash-table-2) "zwei") + (assert-false (equalp hash-table-1 hash-table-2)) + ;; Change the first hash table to be EQUALP to the second one. + (setf (gethash "one" hash-table-1) "eins" + (gethash "two" hash-table-1) "zwei") + (assert-true (equalp hash-table-1 hash-table-2)))) + +(define-test make-your-own-hash-table + ;; Make your own hash table that satisfies the test. + (let ((colors (make-hash-table :test #'equal))) + ;; You will need to modify your hash table after you create it. + (setf (gethash "blue" colors) '(0 0 1) + (gethash "green" colors) '(0 1 0) + (gethash "red" colors) '(1 0 0) + (gethash "black" colors) '(0 0 0)) + (assert-equal (hash-table-count colors) 4) + (let ((values (list (gethash "blue" colors) + (gethash "green" colors) + (gethash "red" colors)))) + (assert-equal values '((0 0 1) (0 1 0) (1 0 0)))))) diff --git a/koans-solved/iteration.lisp b/koans-solved/iteration.lisp new file mode 100644 index 00000000..e820bc51 --- /dev/null +++ b/koans-solved/iteration.lisp @@ -0,0 +1,75 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; Lisp has multiple options for iteration. +;;; This set of koans will introduce some of the most common ones. + +(define-test dolist + (let ((numbers '(4 8 15 16 23 42))) + ;; The macro DOLIST binds a variable to subsequent elements of a list. + (let ((sum 0)) + (dolist (number numbers) + ;; (INCF PLACE N) is equivalent to (SETF PLACE (+ N PLACE)). + (incf sum number)) + (assert-equal ____ sum)) + ;; DOLIST can optionally return a value. + (let ((sum 0)) + (assert-equal ____ (dolist (number numbers sum) + (incf sum number)))))) + +(define-test dotimes + ;; The macro DOTIMES binds a variable to subsequent integers from 0 to + ;; (1- COUNT). + (let ((stack '())) + (dotimes (i 5) + (push i stack)) + (assert-equal ____ stack)) + ;; DOTIMES can optionally return a value. + (let ((stack '())) + (assert-equal ____ (dotimes (i 5 stack) + (push i stack))))) + +(define-test do + ;; The macro DO accepts a list of variable bindings, a termination test with + ;; epilogue forms, and Lisp code that should be executed on each iteration. + (let ((result '())) + (do ((i 0 (1+ i))) + ((> i 5)) + (push i result)) + (assert-equal ____ result)) + ;; The epilogue of DO can return a value. + (let ((result (do ((i 0 (1+ i)) + ;; A variable bound by DO noes not need to be updated on + ;; each iteration. + (result '())) + ((> i 5) (nreverse result)) + (push i result)))) + (assert-equal ____ result))) + +(define-test loop-basic-form + ;; The macro LOOP in its simple form loops forever. It is possible to stop the + ;; looping by calling the RETURN special form. + (let ((counter 0)) + (loop (incf counter) + (when (>= counter 100) + (return counter))) + (assert-equal ___ loop-counter)) + ;; The RETURN special form can return a value out of a LOOP. + (let ((loop-counter 0)) + (assert-equal ___ (loop (incf counter) + (when (>= counter 100) + (return counter))))) + ;; The extended form of LOOP will be contemplated in a future koan. + ) + diff --git a/koans-solved/let.lisp b/koans-solved/let.lisp new file mode 100644 index 00000000..f3a47cbf --- /dev/null +++ b/koans-solved/let.lisp @@ -0,0 +1,62 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +(define-test let + ;; The LET form establishes a lexical extent within which new variables are + ;; created: a symbol that names a variable becomes bound to a value. + (let ((x 10) + (y 20)) + (assert-equal (+ x y) 30) + ;; It is possible to shadow previously visible bindings. + (let ((y 30)) + (assert-equal (+ x y) 40)) + (assert-equal (+ x y) 30)) + ;; Variables bound by LET have a default value of NIL. + (let (x) + (assert-equal x nil))) + +(define-test let-versus-let* + ;; LET* is similar to LET, except the bindings are established sequentially, + ;; and a binding may use bindings that were established before it. + (let ((x 10) + (y 20)) + (let ((x (+ y 100)) + (y (+ x 100))) + (assert-equal 120 x) + (assert-equal 110 y)) + (let* ((x (+ y 100)) + (y (+ x 100))) + ;; Which X is used to compute the value of Y? + (assert-equal 120 x) + (assert-equal 220 y)))) + +(define-test let-it-be-equal + ;; Fill in the LET and LET* to get the tests to pass. + (let ((a 1) + (b :two) + (c "Three")) + (let ((a 100) + (b 200) + (c "Jellyfish")) + (assert-equal a 100) + (assert-equal b 200) + (assert-equal c "Jellyfish")) + (let* ((a 121) + (b 200) + ;; In this third binding, you are allowed to use the variables bound + ;; by the previous two LET* bindings. + (c (+ a (/ b a)))) + (assert-equal a 121) + (assert-equal b 200) + (assert-equal c (+ a (/ b a)))))) diff --git a/koans-solved/lists.lisp b/koans-solved/lists.lisp new file mode 100644 index 00000000..95e1678a --- /dev/null +++ b/koans-solved/lists.lisp @@ -0,0 +1,146 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; A singly linked list is the basic build block of Lisp. Each node of such a +;;; list is called a "cons cell" in Lisp. Each cons cell has two slots: a CAR, +;;; often used to hold an element of a list, and a CDR, often used to reference +;;; the next cons cell. + +(define-test how-to-make-lists + (let (;; Literal lists can be passed by quoting them. + (fruits '(orange pomello clementine)) + ;; Freshly constructed lists can be passed using the LIST function. + (some-evens (list (* 2 1) (* 2 2) (* 2 3))) + ;; Lists can also be passed using quotes and dot notation... + (long-numbers '(16487302 . (3826700034 . (10000000 . nil)))) + ;; ...or by using the function CONS. + (names (cons "Matthew" (cons "Mark" (cons "Margaret" '()))))) + ;; Try filling in the below blanks in different ways. + (assert-equal '(orange pomello clementine) fruits) + (assert-equal '(2 4 6) some-evens) + (assert-equal '(16487302 3826700034 10000000) long-numbers) + (assert-equal '("Matthew" "Mark" "Margaret") names))) + +(define-test cons-tructing-lists + ;; The function CONS can be used to add new elements at the beginning of + ;; an existing list. + (let ((nums '())) + (setf nums (cons :one nums)) + (assert-equal '(:one) nums) + (setf nums (cons :two nums)) + (assert-equal '(:two :one) nums) + ;; Lists can contain anything, even objects of different types. + (setf nums (cons 333 nums)) + (assert-equal '(333 :two :one) nums) + ;; Lists can contain other lists, too. + (setf nums (cons (list "some" "strings") nums)) + (assert-equal '(("some" "strings") 333 :two :one) nums))) + +(define-test car-and-cdr + ;; We may use functions CAR and CDR (or, alternatively, FIRST and REST) to + ;; access the two slots of a cons cell. + (let ((x (cons 1 2))) + (assert-equal 1 (car x)) + (assert-equal 2 (cdr x))) + ;; Calls to CAR and CDR are often intertwined to extract data from a nested + ;; cons structure. + (let ((structure '((1 2) (("foo" . "bar"))))) + (assert-equal '(1 2) (car structure)) + (assert-equal '(("foo" . "bar")) (car (cdr structure))) + (assert-equal "bar" (cdr (car (car (cdr structure))))) + ;; Lisp defines shorthand functions for up to four such nested calls. + (assert-equal '(1 2) (car structure)) + (assert-equal '(("foo" . "bar")) (cadr structure)) + (assert-equal "bar" (cdaadr structure)))) + +(define-test push-pop + ;; PUSH and POP are macros similar to SETF, as both of them operate on places. + (let ((place '(10 20 30 40))) + ;; PUSH sets the value of the place to a new cons cell containing some value + ;; in its CAR. + (push 0 place) + (assert-equal '(0 10 20 30 40) place) + ;; POP removes a single cons cell from a place, sets the place to its CDR, + ;; and returns the value from its CAR. + (let ((value (pop place))) + (assert-equal 0 value) + (assert-equal '(10 20 30 40) place)) + ;; The return value of POP can be discarded to simply "remove" a single cons + ;; cell from a place. + (pop place) + (let ((value (pop place))) + (assert-equal 20 value) + (assert-equal '(30 40) place)))) + +(define-test append-nconc + ;; The functions APPEND and NCONC appends one list to the end of another. + ;; While APPEND creates new lists, NCONC modifies existing ones; therefore + ;; APPEND can be used on literals, but NCONC needs fresh lists. + (assert-equal '(:a :b :c) (append '(:a :b) '(:c))) + (assert-equal '(:a :b :c) (nconc (list :a :b) (list :c))) + (let ((list-1 (list 1 2 3)) + (list-2 (list 4 5 6))) + ;; Both APPEND and NCONC return the appended list, but the interesting part + ;; is what happens when we try to use the original variables passed to them. + (assert-equal '(1 2 3 4 5 6) (append list-1 list-2)) + (assert-equal '(1 2 3) list-1) + (assert-equal '(4 5 6) list-2) + (assert-equal '(1 2 3 4 5 6) (nconc list-1 list-2)) + (assert-equal '(1 2 3 4 5 6) list-1) + (assert-equal '(4 5 6) list-2))) + +(define-test accessing-list-elements + (let ((noms '("peanut" "butter" "and" "jelly"))) + ;; Common Lisp defines accessor functions for lists: FIRST, SECOND, ..., + ;; up to TENTH. + (assert-equal "peanut" (first noms)) + (assert-equal "butter" (second noms)) + (assert-equal "jelly" (fourth noms)) + ;; The function LAST returns the last cons cell of a list. + (assert-equal '("jelly") (last noms)) + ;; The function NTH returns the n-th element of a list. + (assert-equal "butter" (nth 1 noms)) + (assert-equal "peanut" (nth 0 noms)) + (assert-equal "jelly" (nth 3 noms)))) + +(define-test cons-tructing-improper-lists + ;; A proper list is a list whose final CDR ends with NIL. + ;; An improper list either has a non-NIL value in its final CDR or does not + ;; have a final CDR due to a cycle in its structure. + (let (;; We can construct non-cyclic improper lists using LIST*... + (x (list* 1 2 3 4 5)) + ;; ...or pass them as literals via dot notation. + (y '(6 7 8 9 . 0))) + (assert-equal '(4 . 5) (last x)) + (assert-equal '(9 . 0) (last y))) + ;; We can create a cyclic list by changing the last CDR of a list to refer to + ;; another cons cell + (let ((list (list 1 2 3 4 5)) + (cyclic-list (list 1 2 3 4 5))) + (setf (cdr (last cyclic-list)) cyclic-list) + ;; Function LIST-LENGTH returns NIL if a list is cyclic. + (assert-equal 5 (list-length list)) + (assert-equal nil (list-length cyclic-list)) + ;; Many Lisp functions operate only on proper lists. + ;; The function NTH is not one of them; it can be used to retrieve elements + ;; of cyclic lists. + (assert-equal 2 (nth 101 cyclic-list)))) + +(define-test slicing-lists + ;; The function SUBSEQ returns a subsequence of a list. + (let ((noms (list "peanut" "butter" "and" "jelly"))) + (assert-equal '("peanut") (subseq noms 0 1)) + (assert-equal '("peanut" "butter") (subseq noms 0 2)) + (assert-equal '() (subseq noms 2 2)) + (assert-equal '("and" "jelly") (subseq noms 2)))) diff --git a/koans-solved/loops.lisp b/koans-solved/loops.lisp new file mode 100644 index 00000000..85429bdd --- /dev/null +++ b/koans-solved/loops.lisp @@ -0,0 +1,140 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; The extended for of LOOP allows for advanced iteration. +;;; See http://www.gigamonkeys.com/book/loop-for-black-belts.html + +(define-test loop-collect + ;; LOOP can collect the results in various ways. + (let* ((result-1 (loop for letter in '(#\a \b #\c #\d) collect letter)) + (result-2 (loop for number in '(1 2 3 4 5) sum number)) + (result-3 (loop for list in '((foo) (bar) (baz)) append list))) + (assert-equal ____ result-1) + (assert-equal ____ result-2) + (assert-equal ____ result-3))) + +(define-test loop-multiple-variables + ;; With multiple FOR clauses, the loop ends when any of the provided lists are + ;; exhausted. + (let* ((letters '(:a :b :c :d)) + (result (loop for letter in letters + for i from 1 to 1000 + collect (list i letter)))) + (assert-equal ____ result))) + +(define-test loop-in-versus-loop-on + ;; Instead of iterating over each element of a list, we can iterate over each + ;; cons cell of a list. + (let* ((letters '(:a :b :c)) + (result-in (loop for thing in letters collect thing)) + (result-on (loop for thing on letters collect thing))) + (assert-equal ____ result-in) + (assert-equal ____ result-on))) + +(define-test loop-for-by + ;; Numeric iteration can go faster or slower if we use the BY keyword. + (let* ((result (loop for i from 0 to 30 by 5 collect i))) + (assert-equal ____ result))) + +(define-test loop-counting-backwards + ;; We can count downwards instead of upwards by using DOWNTO instead of TO. + (let ((result (loop for i from 5 downto -5 collect i))) + (assert-equal ____ result))) + +(define-test loop-list-by + ;; List iteration can go faster or slower if we use the BY keyword. + (let* ((letters '(:a :b :c :d :e :f)) + (result (loop for letter in letters collect letter)) + (result-cdr (loop for letter in letters by #'cdr collect letter)) + (result-cddr (loop for letter in letters by #'cddr collect letter)) + (result-cdddr (loop for letter in letters by #'cdddr collect letter))) + (assert-equal ____ result-in) + (assert-equal ____ result-in-cdr) + (assert-equal ____ result-in-cddr) + (assert-equal ____ result-in-cdddr))) + +(define-test loop-across + ;; LOOP can iterate over a vector with the ACROSS keyword. + (let* ((vector (make-array '(5) :initial-contents '(0 1 2 3 4))) + (result (loop for number across vector collect number))) + (assert-equal ____ result))) + +(define-test loop-over-2d-array + (let ((array (make-array '(3 2) :initial-contents '((0 1) (2 3) (4 5))))) + ;; LOOP can be combined with ROW-MAJOR-AREF to iterate over the contents of + ;; a multidimensional array. + (let* ((result (loop for i from 0 below (array-total-size array) + collect (row-major-aref my-array i)))) + (assert-equal ____ result)) + ;; It is always possible to resort to nested loops. + (let* ((result (loop with max-i = (array-dimension array 0) + for i from 0 below max-i + collect (loop with max-j = (array-dimension array 1) + for j from 0 below max-j + collect (expt (aref my-array i j) 2))))) + (assert-equal ____ result)))) + +(define-test loop-hash-table + (let ((book-heroes (make-hash-table :test 'equal))) + (setf (gethash "The Hobbit" book-heroes) "Bilbo" + (gethash "Where The Wild Things Are" book-heroes) "Max" + (gethash "The Wizard Of Oz" book-heroes) "Dorothy" + (gethash "The Great Gatsby" book-heroes) "James Gatz") + ;; LOOP can iterate over hash tables. + (let (pairs-in-table (loop for key being the hash-key of book-heroes + using (hash-value value) + collect (list key value))) + (assert-equal ____ (length pairs-in-table)) + (true-or-false? ____ (find '("The Hobbit" "Bilbo") pairs-in-table + :test #'equal))))) + +(define-test loop-statistics + ;; LOOP can perform basics statistics on the collected elements. + (let ((result (loop for x in '(1 2 4 8 16 32) + collect x into collected + count x into counted + sum x into summed + maximize x into maximized + minimize x into minimized + finally (return (list collected counted summed + maximized minimized))))) + (destructuring-bind (collected counted summed maximized minimized) result + (assert-equal ____ collected) + (assert-equal ____ counted) + (assert-equal ____ summed) + (assert-equal ____ maximized) + (assert-equal ____ minimized)))) + +(define-test loop-destructuring + ;; LOOP can bind multiple variables on each iteration step. + (let* ((count 0) + (result (loop for (a b) in '((1 9) (2 8) (3 7) (4 6)) + do (incf count) + collect (+ a b)))) + (assert-equal ____ count) + (assert-equal ____ result))) + +(define-test conditional-execution + (let ((numbers '(1 1 2 3 5 8 13 21))) + ;; LOOP can execute some actions conditionally. + (let ((result (loop for x in numbers + when (evenp x) sum x))) + (assert-equal ____ result)) + (let ((result (loop for x in numbers + unless (evenp x) sum x))) + (assert-equal ____ result)) + (flet ((greater-than-10-p (x) (> x 10))) + (let ((result (loop for x in numbers + when (greater-than-10-p 10) sum x))) + (assert-equal ____ result))))) diff --git a/koans-solved/macros.lisp b/koans-solved/macros.lisp new file mode 100644 index 00000000..f4f9e607 --- /dev/null +++ b/koans-solved/macros.lisp @@ -0,0 +1,116 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; A Lisp macro is a function that accepts Lisp data and produces a Lisp form. +;;; When the macro is called, its macro function receives unevaluated arguments +;;; and may use them to produce a new Lisp form. This form is then spliced in +;;; place of the original macro call and is then evaluated. + +(defmacro my-and (&rest forms) + ;; We use a LABELS local function to allow for recursive expansion. + (labels ((generate (forms) + (cond ((null forms) 'nil) + ((null (rest forms)) (first forms)) + (t `(when ,(first forms) + ,(generate (rest forms))))))) + (generate forms))) + +(define-test my-and + ;; ASSERT-EXPANDS macroexpands the first form once and checks if it is equal + ;; to the second form. + (assert-expands (my-and (= 0 (random 6)) (error "Bang!")) + (when (= 0 (random 6)) (error "Bang!"))) + (assert-expands (my-and (= 0 (random 6)) + (= 0 (random 6)) + (= 0 (random 6)) + (error "Bang!")) + ____)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; A common macro pitfall is capturing a variable defined by the user. + +(define-test variable-capture + (macrolet ((for ((var start stop) &body body) + `(do ((,var ,start (1+ ,var)) + (limit ,stop)) + ((> ,var limit)) + ,@body))) + (let ((limit 10) + (result '())) + (for (i 0 3) + (push i result) + (assert-equal ____ limit)) + (assert-equal ____ (nreverse result))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Another pitfall is evaluating some forms multiple times where they are only +;;; meant to be evaluated once. + +(define-test multiple-evaluation + ;; We use MACROLET for defining a local macro. + (macrolet ((for ((var start stop) &body body) + `(do ((,var ,start (1+ ,var))) + ((> ,var ,stop)) + ,@body))) + (let ((side-effects '()) + (result '())) + ;; Our functions RETURN-0 and RETURN-3 have side effects. + (flet ((return-0 () (push 0 side-effects) 0) + (return-3 () (push 3 side-effects) 3)) + (for (i (return-0) (return-3)) + (push i result))) + (assert-equal ____ (nreverse result)) + (assert-equal ____ (nreverse side-effects))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Yet another pitfall is not respecting the evaluation order of the macro +;;; subforms. + +(define-test wrong-evaluation-order + (macrolet ((for ((var start stop) &body body) + ;; The function GENSYM creates GENerated SYMbols, guaranteed to + ;; be unique in the whole Lisp system. Because of that, they + ;; cannot capture other symbols, preventing variable capture. + (let ((limit (gensym "LIMIT"))) + `(do ((,limit ,stop) + (,var ,start (1+ ,var))) + ((> ,var ,limit)) + ,@body)))) + (let ((side-effects '()) + (result '())) + (flet ((return-0 () (push 0 side-effects) 0) + (return-3 () (push 3 side-effects) 3)) + (for (i (return-0) (return-3)) + (push i result))) + (assert-equal ____ (nreverse result)) + (assert-equal ____ (nreverse side-effects))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-test for + (macrolet ((for ((var start stop) &body body) + ;; Fill in the blank with a correct FOR macroexpansion that is + ;; not affected by the three macro pitfalls mentioned above. + ____)) + (let ((side-effects '()) + (result '())) + (flet ((return-0 () (push 0 side-effects) 0) + (return-3 () (push 3 side-effects) 3)) + (for (i (return-0) (return-3)) + (push i result))) + (assert-equal '(0 1 2 3) (nreverse result)) + (assert-equal '(0 3) (nreverse side-effects))))) diff --git a/koans-solved/mapcar-and-reduce.lisp b/koans-solved/mapcar-and-reduce.lisp new file mode 100644 index 00000000..4df282a6 --- /dev/null +++ b/koans-solved/mapcar-and-reduce.lisp @@ -0,0 +1,97 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; Lisp supports several functional alternatives to imperative iteration. + +(define-test mapcar + (let ((numbers '(1 2 3 4 5 6))) + ;; Inside MAPCAR, he function 1+ will be applied to each element of NUMBERS. + ;; A new list will be collected from the results. + (assert-equal '(2 3 4 5 6 7) (mapcar #'1+ numbers)) + (assert-equal ____ (mapcar #'- numbers)) + (assert-equal ____ (mapcar #'list numbers)) + (assert-equal ____ (mapcar #'evenp numbers)) + (assert-equal ____ (mapcar #'numberp numbers)) + (assert-equal ____ (mapcar #'stringp numbers)) + ;; MAPCAR can work on multiple lists. The function will receive one argument + ;; from each list. + (let (other-numbers '(4 8 15 16 23 42)) + (assert-equal ____ (mapcar #'+ numbers other-numbers)) + (assert-equal ____ (mapcar #'* numbers other-numbers)) + ;; The function MOD performs modulo division. + (assert-equal ____ (mapcar #'mod other-numbers numbers))))) + +(define-test mapcar-lambda + ;; MAPCAR is often used with anonymous functions. + (let ((numbers '(8 21 152 37 403 14 7 -34))) + (assert-equal ____ (mapcar (lambda (x) (mod x 10)) numbers))) + (let ((strings '("Mary had a little lamb" + "Old McDonald had a farm" + "Happy birthday to you"))) + (assert-equal ____ (mapcar (lambda (x) (subseq x 4 12)) strings)))) + +(define-test map + ;; MAP is a variant of MAPCAR that works on any sequences. + ;; It allows to specify the type of the resulting sequence. + (let ((string "lorem ipsum")) + (assert-equal ____ (map 'string #'char-upcase string)) + (assert-equal ____ (map 'list #'char-upcase string)) + ;; Not all vectors containing characters are strings. + (assert-equal ____ (map '(vector t) #'char-upcase string)))) + +(define-test transposition + ;; MAPCAR gives the function as many arguments as there are lists. + (flet ((transpose (lists) (apply #'mapcar ____ lists))) + (let ((list '((1 2 3) + (4 5 6) + (7 8 9))) + (transposed-list '((1 4 7) + (2 5 8) + (3 6 9))))) + (assert-equal transposed-list (transpose list)) + (assert-equal ____ (transpose (transpose list)))) + (assert-equal ____ (transpose '(("these" "making") + ("pretzels" "me") + ("are" "thirsty"))))) + +(define-test reduce + ;; The function REDUCE combines the elements of a list by applying a binary + ;; function to the elements of a sequence from left to right. + (assert-equal 15 (reduce #'+ '(1 2 3 4 5))) + (assert-equal ____ (reduce #'+ '(1 2 3 4))) + (assert-equal ____ (reduce #'expt '(1 2 3 4 5)))) + +(define-test reduce-from-end + ;; The :FROM-END keyword argument can be used to reduce from right to left. + (let ((numbers '(1 2 3 4 5))) + (assert-equal ____ (reduce #'cons numbers)) + (assert-equal ____ (reduce #'cons numbers :from-end t))) + (let ((numbers '(2 3 2))) + (assert-equal ____ (reduce #'expt numbers)) + (assert-equal ____ (reduce #'expt numbers :from-end t)))) + +(define-test reduce-initial-value + ;; :INITIAL-VALUE can supply the initial value for the reduction. + (let ((numbers '(1 2 3 4 5))) + (assert-equal ____ (reduce #'* numbers)) + (assert-equal ____ (reduce #'* numbers :initial-value 0)) + (assert-equal ____ (reduce #'* numbers :initial-value -1)))) + +(define-test inner-product + ;; MAPCAR and REDUCE are powerful when used together. + ;; Fill in the blanks to produce a local function that computes an inner + ;; product of two vectors. + (flet ((inner-product (x y) (reduce ____ (mapcar ____ x y)))) + (assert-equal 32 (inner-product '(1 2 3) '(4 5 6))) + (assert-equal 310 (inner-product '(10 20 30) '(4 3 7))))) diff --git a/koans-solved/multiple-values.lisp b/koans-solved/multiple-values.lisp new file mode 100644 index 00000000..511368d4 --- /dev/null +++ b/koans-solved/multiple-values.lisp @@ -0,0 +1,41 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; In Lisp, it is possible for a function to return more than one value. +;;; This is distinct from returning a list or structure of values. + +(define-test multiple-values + (let ((x (floor 3/2)) + ;; The macro MULTIPLE-VALUE-LIST returns a list of all values returned + ;; by a Lisp form. + (y (multiple-value-list (floor 3/2)))) + (assert-equal x 1) + (assert-equal y '(1 1/2))) + (assert-equal '(24 3/4) (multiple-value-list (floor 99/4)))) + +(defun next-fib (a b) + ;; The function VALUES allows returning multiple values. + (values b (+ a b))) + +(define-test binding-and-setting-multiple-values + ;; The macro MULTIPLE-VALUE-BIND is like LET, except it binds the variables + ;; listed in its first argument to the values returned by the form that is its + ;; second argument. + (multiple-value-bind (x y) (next-fib 3 5) + (let ((result (* x y))) + (assert-equal 40 result))) + ;; SETF can also set multiple values if a VALUES form is provided as a place. + (let (x y) + (setf (values x y) (next-fib 5 8)) + (assert-equal '(8 13) (list x y)))) diff --git a/koans-solved/nil-false-empty.lisp b/koans-solved/nil-false-empty.lisp new file mode 100644 index 00000000..ebbd6ebd --- /dev/null +++ b/koans-solved/nil-false-empty.lisp @@ -0,0 +1,52 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +(define-test t-and-nil-are-opposites + ;; NOT is a function which returns the boolean opposite of its argument. + (true-or-false? t (not nil)) + (true-or-false? nil (not t))) + +(define-test nil-and-empty-list-are-the-same-thing + ;; In Common Lisp, NIL is also the empty list. + (true-or-false? nil '()) + (true-or-false? t (not '()))) + +(define-test in-lisp-many-things-are-true + ;; In Common Lisp, the canonical values for truth is T. + ;; However, everything that is non-NIL is true, too. + (true-or-false? t 5) + (true-or-false? nil (not 5)) + (true-or-false? t "a string") + ;; Even an empty string... + (true-or-false? t "") + ;; ...or a list containing a NIL... + (true-or-false? t (list nil)) + ;; ...or an array with no elements... + (true-or-false? t (make-array 0)) + ;; ...or the number zero. + (true-or-false? t 0)) + +(define-test and + ;; The logical operator AND can take multiple arguments. + (true-or-false? t (and t t t t t)) + (true-or-false? nil (and t t nil t t)) + ;; If all values passed to AND are true, it returns the last value. + (assert-equal 5 (and t t t t t 5))) + +(define-test or + ;; The logical operator OR can also take multiple arguments. + (true-or-false? t (or nil nil nil t nil)) + ;; OR returns the first non-NIL value it encounters, or NIL if there are none. + (assert-equal nil (or nil nil nil)) + (assert-equal 1 (or 1 2 3 4 5))) diff --git a/koans-solved/scope-and-extent.lisp b/koans-solved/scope-and-extent.lisp new file mode 100644 index 00000000..16c0aa62 --- /dev/null +++ b/koans-solved/scope-and-extent.lisp @@ -0,0 +1,48 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +(define-test shadowing + (assert-equal '(4 2) (let ((z 4)) (list z (let ((z 2)) z))))) + +(defun block-1 () + (block here + (return-from here 4) + 5)) + +(defun block-2 () + (block outer + (block inner + (return-from outer 'space) + (return-from inner 'tube)) + (return-from outer 'valve))) + +(define-test block-return-from + (assert-equal 4 (block-1)) + (assert-equal 'space (block-2))) + +;;; See http://www.gigamonkeys.com/book/variables.html + +(define-test lexical-variables-can-be-enclosed + (assert-equal 10 (let ((f (let ((x 10)) + (lambda () x)))) + (let ((x 20)) + (funcall f))))) + +(define-test dynamic-variables-are-affected-by-execution-path + (assert-equal 20 (let ((f (let ((x 10)) + (declare (special x)) + (lambda () x)))) + (let ((x 20)) + (declare (special x)) + (funcall f))))) diff --git a/koans-solved/scoring-project.lisp b/koans-solved/scoring-project.lisp new file mode 100644 index 00000000..33aea48a --- /dev/null +++ b/koans-solved/scoring-project.lisp @@ -0,0 +1,82 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; Greed is a dice game played among 2 or more players, using 5 +;;; six-sided dice. +;;; +;;; Each player takes a turn consisting of one or more rolls of the dice. +;;; On the first roll of the game, a player rolls all five dice which are +;;; scored according to the following: +;;; +;;; Three 1's => 1000 points +;;; Three 6's => 600 points +;;; Three 5's => 500 points +;;; Three 4's => 400 points +;;; Three 3's => 300 points +;;; Three 2's => 200 points +;;; One 1 => 100 points +;;; One 5 => 50 points +;;; +;;; A single die can only be counted once in each roll. For example, +;;; a "5" can only count as part of a triplet (contributing to the 500 +;;; points) or as a single 50 points, but not both in the same roll. +;;; +;;; Example Scoring +;;; +;;; Throw Score +;;; --------- ------------------ +;;; 5 1 3 4 1 50 + 2 * 100 = 250 +;;; 1 1 1 3 1 1000 + 100 = 1100 +;;; 2 4 4 5 4 400 + 50 = 450 +;;; +;;; The dice not contributing to the score are called the non-scoring +;;; dice. "3" and "4" are non-scoring dice in the first example. "3" is +;;; a non-scoring die in the second, and "2" is a non-score die in the +;;; final example. +;;; +;;; More scoring examples are given in the tests below. +;;; +;;; Your goal is to write the scoring function for Greed. + +(defun score (&rest dice) + ____) + +(define-test score-of-an-empty-list-is-zero + (assert-equal 0 (score))) + +(define-test score-of-a-single-roll-of-5-is-50 + (assert-equal 50 (score 5))) + +(define-test score-of-a-single-roll-of-1-is-100 + (assert-equal 100 (score 1))) + +(define-test score-of-multiple-1s-and-5s-is-the-sum-of-individual-scores + (assert-equal 300 (score 1 5 5 1))) + +(define-test score-of-single-2s-3s-4s-and-6s-are-zero + (assert-equal 0 (score 2 3 4 6))) + +(define-test score-of-a-triple-1-is-1000 + (assert-equal 1000 (score 1 1 1))) + +(define-test score-of-other-triples-is-100x + (assert-equal 200 (score 2 2 2)) + (assert-equal 300 (score 3 3 3)) + (assert-equal 400 (score 4 4 4)) + (assert-equal 500 (score 5 5 5)) + (assert-equal 600 (score 6 6 6))) + +(define-test score-of-mixed-is-sum + (assert-equal 250 (score 2 5 2 2 3)) + (assert-equal 550 (score 5 5 5 5))) diff --git a/koans-solved/std-method-comb.lisp b/koans-solved/std-method-comb.lisp new file mode 100644 index 00000000..f456d35d --- /dev/null +++ b/koans-solved/std-method-comb.lisp @@ -0,0 +1,219 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +(defclass access-counter () + ((value :reader value :initform :value) + (access-count :reader access-count :initform 0))) + +;;; The generated reader, writer, and accessor functions are generic functions. +;;; The methods of a generic function are combined using a method combination; +;;; by default, the standard method combination is used. + +;;; This allows us to define :BEFORE and :AFTER methods whose code is executed +;;; before or after the primary method, and whose return values are discarded. +;;; The :BEFORE and :AFTER keywords used in this context are called qualifiers. + +(defmethod value :after ((object access-counter)) + (incf (slot-value object 'access-count))) + +(defmethod (setf value) :after ((object access-counter)) + (incf (slot-value object 'access-count))) + +(define-test defmethod-after + (let ((counter (make-instance 'access-counter :value 42))) + (assert-equal ____ (access-count counter)) + (assert-equal ____ (value counter)) + (assert-equal ____ (access-count counter)) + (setf (value counter) 24) + (assert-equal ____ (access-count counter)) + (assert-equal ____ (value counter)) + (assert-equal ____ (access-count counter)) + ;; We read the value three more times and discard the result. + (value counter) + (value counter) + (value counter) + (assert-equal ____ (access-count counter)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; In addition to :BEFORE and :AFTER methods is also possible to write :AROUND +;;; methods, whose code executes around the primary method. In such context, it +;;; is possible to call the primary method via CALL-NEXT-METHOD. +;;; In the standard method combination, the :AFTER method, if one exists, is +;;; executed first, and it may choose whether and how to call next methods. + +(defgeneric grab-lollipop () + (:method () :lollipop)) + +(defgeneric grab-lollipop-while-mom-is-nearby (was-nice-p) + (:method :around (was-nice-p) (if was-nice-p (call-next-method) :no-lollipop)) + (:method (was-nice-p) (declare (ignore was-nice-p)) :lollipop)) + +(define-test lollipop + (assert-equal ____ (grab-lollipop)) + (assert-equal ____ (grab-lollipop-while-mom-is-nearby t)) + (assert-equal ____ (grab-lollipop-while-mom-is-nearby nil))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass countdown () + ;; The countdown object represents an ongoing countdown. Each time the + ;; REMAINING-TIME function is called, it should return a number one less than + ;; the previous time that it returned. If the countdown hits zero, :BANG + ;; should be returned instead. + ((remaining-time :reader remaining-time :initarg :value))) + +(defmethod remaining-time :around ((object countdown)) + (let ((value (call-next-method))) + (if (<= 0 value) + ;; DECF is similar to INCF. It decreases the value stored in the place + ;; and returns the decreased value. + (decf value) + :bang))) + +(define-test countdown + (let ((countdown (make-instance 'countdown :value 4))) + (assert-equal 3 (remaining-time countdown)) + (assert-equal 2 (remaining-time countdown)) + (assert-equal 1 (remaining-time countdown)) + (assert-equal :bang (remaining-time countdown)) + (assert-equal :bang (remaining-time countdown)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; It is possible for multiple :BEFORE, :AFTER, :AROUND, or primary methods to +;;; be executed in a single method call. + +(defclass object () + ((counter :accessor counter :initform 0))) + +(defclass bigger-object (object) ()) + +(defgeneric frobnicate (x) + (:method :around ((x bigger-object)) + (incf (counter x) 8) + (call-next-method)) + (:method :around ((x object)) + (incf (counter x) 70) + (call-next-method)) + (:method :before ((x bigger-object)) + (incf (counter x) 600)) + (:method :before ((x object)) + (incf (counter x) 5000)) + (:method ((x bigger-object)) + (incf (counter x) 40000) + (call-next-method)) + (:method ((x object)) + (incf (counter x) 300000)) + (:method :after ((x object)) + (incf (counter x) 2000000)) + (:method :after ((x bigger-object)) + (incf (counter x) 10000000))) + +(define-test multiple-methods + (let ((object (make-instance 'object))) + (frobnicate object) + (assert-equal ____ (counter object))) + (let ((object (make-instance 'bigger-object))) + (frobnicate object) + (assert-equal ____ (counter object)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; The method order of the standard combination is as follows: +;;; First, the most specific :AROUND method is executed. +;;; Second, all :BEFORE methods are executed, most specific first. +;;; Third, the most specific primary method is executed. +;;; Fourth, all :AFTER methods are executed, most specific last. + +(defgeneric calculate (x) + (:method :around ((x bigger-object)) + (setf (counter x) 40) + (call-next-method)) + (:method :around ((x object)) + (incf (counter x) 24) + (call-next-method)) + (:method :before ((x bigger-object)) + (setf (counter x) (mod (counter x) 6))) + (:method :before ((x object)) + (setf (counter x) (/ (counter x) 4))) + (:method ((x bigger-object)) + (setf (counter x) (* (counter x) (counter x))) + (call-next-method)) + (:method ((x object)) + (decf (counter x) 100)) + (:method :after ((x object)) + (setf (counter x) (/ 1 (counter x)))) + (:method :after ((x bigger-object)) + (incf (counter x) 2))) + +(define-test standard-method-combination-order + (let ((object (make-instance 'object))) + (calculate object) + (assert-equal ____ (counter object))) + (let ((object (make-instance 'bigger-object))) + (calculate object) + (assert-equal ____ (counter object)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defclass programmer () ()) + +(defclass senior-programmer (programmer) ()) + +(defclass full-stack-programmer (programmer) ()) + +(defclass senior-full-stack-programmer (senior-programmer + full-stack-programmer) + ()) + +;;; The :BEFORE, :AFTER, and :AROUND methods are only available in the standard +;;; method combination. It is possible to use other method combinations, such as +;;; +. + +(defgeneric salary-at-company-a (programmer) + (:method-combination +) + (:method + ((programmer programmer)) 120000) + (:method + ((programmer senior-programmer)) 200000) + (:method + ((programmer full-stack-programmer)) 48000)) + +(define-test salary-at-company-a + (let ((programmer (make-instance 'programmer))) + (assert-equal ____ (salary-at-company-a programmer))) + (let ((programmer (make-instance 'senior-programmer))) + (assert-equal ____ (salary-at-company-a programmer))) + (let ((programmer (make-instance 'full-stack-programmer))) + (assert-equal ____ (salary-at-company-a programmer))) + (let ((programmer (make-instance 'senior-full-stack-programmer))) + (assert-equal ____ (salary-at-company-a programmer)))) + +;;; It is also possible to define custom method combinations. + +(define-method-combination multiply :operator *) + +(defgeneric salary-at-company-b (programmer) + (:method-combination multiply) + (:method multiply ((programmer programmer)) 120000) + (:method multiply ((programmer senior-programmer)) 2) + (:method multiply ((programmer full-stack-programmer)) 7/5)) + +(define-test salary-at-company-b + (let ((programmer (make-instance 'programmer))) + (assert-equal ____ (salary-at-company-b programmer))) + (let ((programmer (make-instance 'senior-programmer))) + (assert-equal ____ (salary-at-company-b programmer))) + (let ((programmer (make-instance 'full-stack-programmer))) + (assert-equal ____ (salary-at-company-b programmer))) + (let ((programmer (make-instance 'senior-full-stack-programmer))) + (assert-equal ____ (salary-at-company-b programmer)))) diff --git a/koans-solved/strings.lisp b/koans-solved/strings.lisp new file mode 100644 index 00000000..87a57eb9 --- /dev/null +++ b/koans-solved/strings.lisp @@ -0,0 +1,73 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +(define-test what-is-a-string + (let ((string "Do, or do not. There is no try.")) + (true-or-false? t (typep string 'string)) + ;; Strings are vectors of characters. + (true-or-false? t (typep string 'array)) + (true-or-false? t (typep string 'vector)) + (true-or-false? t (typep string '(vector character))) + (true-or-false? nil (typep string 'integer)))) + +(define-test multiline-string + ;; A Lisp string can span multiple lines. + (let ((string "this is + a multi + line string")) + (true-or-false? t (typep string 'string)))) + +(define-test escapes-in-strings + ;; Quotes and backslashes in Lisp strings must be escaped. + (let ((my-string "this string has one of these \" and a \\ in it")) + (true-or-false? t (typep my-string 'string)))) + +(define-test substrings + ;; Since strings are sequences, it is possible to use SUBSEQ on them. + (let ((string "Lorem ipsum dolor sit amet")) + (assert-equal "dolor sit amet" (subseq string 12)) + (assert-equal "ipsum" (subseq string 6 11)) + (assert-equal "orem" (subseq string 1 5)))) + +(define-test strings-versus-characters + ;; Strings and characters have distinct types. + (true-or-false? t (typep #\a 'character)) + (true-or-false? nil (typep "A" 'character)) + (true-or-false? nil (typep #\a 'string)) + ;; One can use both AREF and CHAR to refer to characters in a string. + (let ((my-string "Cookie Monster")) + (assert-equal #\C (char my-string 0)) + (assert-equal #\k (char my-string 3)) + (assert-equal #\M (aref my-string 7)))) + +(define-test concatenating-strings + ;; Concatenating strings in Common Lisp is possible, if a little cumbersome. + (let ((a "Lorem") + (b "ipsum") + (c "dolor")) + (assert-equal "Lorem ipsum dolor" (concatenate 'string a " " b " " c)))) + +(define-test searching-for-characters + ;; The function POSITION can be used to find the first position of an element + ;; in a sequence. If the element is not found, NIL is returned. + (assert-equal 1 (position #\b "abc")) + (assert-equal 2 (position #\c "abc")) + (assert-equal nil (position #\d "abc"))) + +(define-test finding-substrings + ;; The function SEARCH can be used to search a sequence for subsequences. + (let ((title "A supposedly fun thing I'll never do again")) + (assert-equal 2 (search "supposedly" title)) + (assert-equal 12 (search " fun" title)))) + diff --git a/koans-solved/structures.lisp b/koans-solved/structures.lisp new file mode 100644 index 00000000..362eddb9 --- /dev/null +++ b/koans-solved/structures.lisp @@ -0,0 +1,111 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; Lisp structures encapsulate data which belongs together. They are a template +;;; of sorts, providing a way to generate multiple instances of uniformly +;;; organized information +;;; Defining a structure also interns accessor functions to get and set the +;;; slots of that structure. + +;;; The following form creates a new structure class named BASKETBALL-PLAYER +;;; with slots named NAME, TEAM, and NUMBER. +;;; This additionally creates functions MAKE-BASKETBALL-PLAYER, +;;; COPY-BASKETBALL-PLAYER, BASKETBALL-PLAYER-P, BASKETBALL-PLAYER-NAME, +;;; BASKETBALL-PLAYER-TEAM, and BASKETBALL-PLAYER-NUMBER. + +(defstruct basketball-player + name team number) + +(define-test make-struct + (let ((player (make-basketball-player :name "Larry" :team :celtics + :number 33))) + (true-or-false? t (basketball-player-p player)) + (assert-equal "Larry" (basketball-player-name player)) + (assert-equal :celtics (basketball-player-team player)) + (assert-equal 33 (basketball-player-number player)) + (setf (basketball-player-team player) :retired) + (assert-equal :retired (basketball-player-team player)))) + +;;; Structure fields can have default values. + +(defstruct baseball-player + name (team :red-sox) (position :outfield)) + +(define-test struct-defaults + (let ((player (make-baseball-player))) + ;; We have not specified a default value for NAME, therefore we cannot + ;; read it here - it would invoke undefined behaviour. + (assert-equal :red-sox (baseball-player-team player)) + (assert-equal :outfield (baseball-player-position player)))) + +;;; The accessor names can get pretty long. It's possible to specify a different +;;; prefix with the :CONC-NAME option. + +(defstruct (american-football-player (:conc-name nfl-guy-)) + name position team) + +(define-test struct-access + (let ((player (make-american-football-player + :name "Drew Brees" :position :qb :team "Saints"))) + (assert-equal "Drew Brees" (nfl-guy-name player)) + (assert-equal "Saints" (nfl-guy-team player)) + (assert-equal :qb (nfl-guy-position player)))) + +;;; Structs can be defined to include other structure definitions. +;;; This form of inheritance allows composition of objects. + +(defstruct (nba-contract (:include basketball-player)) + salary start-year end-year) + +(define-test structure-inheritance + (let ((contract (make-nba-contract :salary 136000000 + :start-year 2004 :end-year 2011 + :name "Kobe Bryant" + :team :lakers :number 24))) + (assert-equal 2004 (nba-contract-start-year contract)) + (assert-equal 'nba-contract (type-of contract)) + ;; Inherited structures follow the rules of type hierarchy. + (true-or-false? t (typep contract 'basketball-player)) + ;; One can access structure fields both with the structure's own accessors + ;; and with the inherited accessors. + (assert-equal :lakers (nba-contract-team contract)) + (assert-equal :lakers (basketball-player-team contract)))) + +;;; Copying a structure named FOO is handled with the COPY-FOO function. +;;; All such copies are shallow. + +(define-test structure-equality-and-copying + (let ((manning-1 (make-american-football-player + :name "Manning" :team (list "Colts" "Broncos"))) + (manning-2 (make-american-football-player + :name "Manning" :team (list "Colts" "Broncos")))) + ;; MANNING-1 and MANNING-2 are different objects... + (true-or-false? nil (eq manning-1 manning-2)) + ;;...but they contain the same information. + (true-or-false? t (equalp manning-1 manning-2)) + (let ((manning-3 (copy-american-football-player manning-1))) + (true-or-false? nil (eq manning-1 manning-3)) + (true-or-false? t (equalp manning-1 manning-3)) + ;; Setting the slot of one instance does not modify the others... + (setf (nfl-guy-name manning-1) "Rogers") + (true-or-false? nil (string= (nfl-guy-name manning-1) + (nfl-guy-name manning-3))) + (assert-equal "Rogers" (nfl-guy-name manning-1)) + (assert-equal "Manning" (nfl-guy-name manning-3)) + ;; ...but modifying shared structure may affect other instances. + (setf (car (nfl-guy-team manning-1)) "Giants") + (true-or-false? t (string= (car (nfl-guy-team manning-1)) + (car (nfl-guy-team manning-3)))) + (assert-equal "Giants" (car (nfl-guy-team manning-1))) + (assert-equal "Giants" (car (nfl-guy-team manning-3)))))) diff --git a/koans-solved/threads.lisp b/koans-solved/threads.lisp new file mode 100644 index 00000000..318e39f1 --- /dev/null +++ b/koans-solved/threads.lisp @@ -0,0 +1,161 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; This lesson group uses Quicklisp to load Bordeaux Threads, a portability +;;; library for working with threads. This is because threads are not a part of +;;; the Common Lisp standard and implementations do them differently. +;;; If you are using Quicklisp, please feel free to enable this lesson by +;;; following the instructions in the README. + +;;; TODO: wait for Bordeaux Threads to implement a portable SEMAPHORE-COUNT +;;; and use it in the semaphore koans. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-test thread-return-value + ;; When a thread object is constructed, it accepts a function to execute. + (let* ((thread (bt:make-thread (lambda () (+ 2 2)))) + ;; When the thread's function finishes, its return value becomes the + ;; return value of BT:JOIN-THREAD. + (value (bt:join-thread thread))) + (assert-equal ____ value))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar *variable*) + +(define-test thread-global-bindings + ;; The global value of a variable is shared between all threads. + (setf *variable* 42) + (let ((thread (bt:make-thread (lambda () + (when (= *variable* 42) + (setf *variable* 24) + t))))) + (assert-true (bt:join-thread thread)) + (assert-equal ____ *variable*))) + +(define-test thread-local-bindings + ;; Newly established local bindings of a variable are visible only in the + ;; thread that established these bindings. + (setf *variable* 42) + (let ((thread (bt:make-thread (lambda () + (let ((*variable* 42)) + (setf *variable* 24)))))) + (bt:join-thread thread) + (assert-equal ____ *variable*))) + +(define-test thread-initial-bindings + ;; Initial dynamic bindings may be passed to the new thread. + (setf *variable* 42) + (let ((thread (bt:make-thread (lambda () (setf *variable* 24)) + :initial-bindings '((*variable* . 42))))) + (bt:join-thread thread) + (assert-equal ____ *variable*))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-test thread-name + ;; Threads can have names. + (let ((thread (bt:make-thread #'+ :name "Summing thread"))) + (assert-equal ____ (bt:thread-name thread)) + (assert-equal ____ (bt:join-thread thread)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-test thread-function-arguments + ;; Passing arguments to thread functions requires closing over them. + (let* ((x 240) + (y 18) + (thread (bt:make-thread (lambda () (* x y))))) + (assert-equal ____ (bt:join-thread thread)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-test destroy-thread + ;; Looping and renegade threads can usually be killed via BT:DESTROY-THREAD. + ;; It is the last measure, since doing so might leave the Lisp system in an + ;; unpredictable state if the thread was doing something complex. + (let ((thread (bt:make-thread (lambda () (loop (sleep 1)))))) + (true-or-false? ____ (bt:thread-alive-p thread)) + (bt:destroy-thread thread) + (true-or-false? ____ (bt:thread-alive-p thread)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar *another-variable*) + +;; Preventing concurrent access to some data can be achieved via a lock in +;; order to avoid race conditions. + +(defvar *lock* (bt:make-lock)) + +(define-test lock + (setf *another-variable* 0) + (flet ((increaser () (bt:with-lock-held (*lock*) (incf *another-variable*)))) + (loop repeat 100 + collect (bt:make-thread #'increaser) into threads + finally (loop until (notany #'bt:thread-alive-p threads)) + (assert-equal ____ *another-variable*)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; We can further orchestrate threads by using semaphores. + +(defvar *semaphore* (bt:make-semaphore)) + +(defun signal-our-semaphore () + (bt:signal-semaphore semaphore)) + +(defun wait-on-our-semaphore () + (bt:wait-on-semaphore semaphore :timeout 100)) + +(define-test semaphore + (assert-equal 1 (bt:join-thread (bt:make-thread #'signal-our-semaphore))) + (assert-equal ____ (bt:join-thread (bt:make-thread #'signal-our-semaphore))) + (assert-equal ____ (bt:join-thread (bt:make-thread #'signal-our-semaphore))) + (assert-equal 2 (bt:join-thread (bt:make-thread #'wait-on-our-semaphore))) + (assert-equal ____ (bt:join-thread (bt:make-thread #'wait-on-our-semaphore))) + (assert-equal ____ (bt:join-thread (bt:make-thread #'wait-on-our-semaphore))) + (assert-equal ____ (bt:join-thread (bt:make-thread #'wait-on-our-semaphore)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Semaphores can be used to manage resource allocation and to trigger some +;; threads to run when the semaphore value is above zero. + +(defvar *foobar-semaphore* (bt:make-semaphore)) + +(defvar *foobar-list*) + +(defun bar-pusher () + (dotimes (i 10) + (sleep 0.01) + (push i (nth i *foobar-list*)) + (push :bar (nth i *foobar-list*)) + ;; We push :BAR before :FOO, so the final list looks like (:FOO :BAR). + (bt:signal-semaphore *foobar-semaphore*))) + +(defun foo-pusher () + (dotimes (i 10) + (bt:wait-on-semaphore *foobar-semaphore*) + (push :foo (nth i *foobar-list*)))) + +(define-test list-of-foobars + (setf *foobar-list* (make-list 10)) + (let ((bar-pusher (bt:make-thread #'bar-pusher)) + (foo-pusher (bt:make-thread #'foo-pusher))) + (bt:join-thread foo-pusher)) + (assert-equal ____ (nth 0 *foobar-list*)) + (assert-equal ____ (nth 1 *foobar-list*)) + (assert-equal ____ (nth 5 *foobar-list*))) diff --git a/koans-solved/triangle-project.lisp b/koans-solved/triangle-project.lisp new file mode 100644 index 00000000..2eec4805 --- /dev/null +++ b/koans-solved/triangle-project.lisp @@ -0,0 +1,64 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +(define-condition triangle-error (error) + ;; Fill in the blank with a suitable slot definition. + (____)) + +(defun triangle (a b c) + ;;;Fill in the blank with a function that satisfies the below tests. + ____) + +(define-test equilateral-triangles + ;; Equilateral triangles have three sides of equal length, + (assert-equal :equilateral (triangle 2 2 2)) + (assert-equal :equilateral (triangle 10 10 10))) + +(define-test isosceles-triangles + ;; Isosceles triangles have two sides of equal length, + (assert-equal :isosceles (triangle 3 4 4)) + (assert-equal :isosceles (triangle 4 3 4)) + (assert-equal :isosceles (triangle 4 4 3)) + (assert-equal :isosceles (triangle 10 10 2))) + +(define-test scalene-triangles + ;; Scalene triangles have three sides of different lengths. + (assert-equal :scalene (triangle 3 4 5)) + (assert-equal :scalene (triangle 10 11 12)) + (assert-equal :scalene (triangle 5 4 2))) + +(define-test illegal-triangles + ;; Not all triplets make valid triangles. + (flet ((triangle-failure (a b c) + (handler-case (progn (triangle a b c) (error "Test failure")) + (error (condition) condition)))) + (let ((condition (triangle-failure 0 0 0))) + (assert-true (typep condition 'type-error)) + (assert-equal 0 (type-error-datum)) + ;; The type (REAL (0)) represents all positive numbers. + (assert-true (subtypep (type-error-expected-type condition) '(real (0)))) + ;; If two type specifiers are SUBTYPEP of one another, then they represent + ;; the same Lisp type. + (assert-true (subtypep '(real (0)) (type-error-expected-type condition)))) + (let ((condition (triangle-failure 3 4 -5))) + (assert-true (typep condition 'type-error)) + (assert-equal -5 (type-error-datum)) + (assert-true (subtypep (type-error-expected-type condition) '(real (0)))) + (assert-true (subtypep '(real (0)) (type-error-expected-type condition)))) + (let ((condition (triangle-failure 1 1 3))) + (assert-true (typep condition 'triangle-error)) + (assert-equal '(1 1 3) (triangle-error-sides condition))) + (let ((condition (triangle-failure 2 4 2))) + (assert-true (typep condition 'triangle-error)) + (assert-equal '(2 4 2) (triangle-error-sides condition))))) diff --git a/koans-solved/type-checking.lisp b/koans-solved/type-checking.lisp new file mode 100644 index 00000000..62c6c11a --- /dev/null +++ b/koans-solved/type-checking.lisp @@ -0,0 +1,152 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; There is a type hierarchy in Lisp, based on the set theory. +;;; An object may belong to multiple types at the same time. +;;; Every object is of type T. No object is of type NIL. + +(define-test typep + ;; TYPEP returns true if the provided object is of the provided type. + (true-or-false? ____ (typep "hello" 'string)) + (true-or-false? ____ (typep "hello" 'array)) + (true-or-false? ____ (typep "hello" 'list)) + (true-or-false? ____ (typep "hello" '(simple-array character (5)))) + (true-or-false? ____ (typep '(1 2 3) 'list)) + (true-or-false? ____ (typep 99 'integer)) + (true-or-false? ____ (typep nil 'NULL)) + (true-or-false? ____ (typep 22/7 'ratio)) + (true-or-false? ____ (typep 4.0 'float)) + (true-or-false? ____ (typep #\a 'character)) + (true-or-false? ____ (typep #'length 'function))) + +(define-test type-of + ;; TYPE-OF returns a type specifier for the object. + (assert-equal ____ (type-of '())) + (assert-equal ____ (type-of 4/6))) + +(define-test overlapping-types + ;; Because Lisp types are mathematical sets, they are allowed to overlap. + (let ((thing '())) + (true-or-false? ____ (typep thing 'list)) + (true-or-false? ____ (typep thing 'atom)) + (true-or-false? ____ (typep thing 'null)) + (true-or-false? ____ (typep thing 't)))) + +(define-test fixnum-versus-bignum + ;; In Lisp, integers are either fixnums or bignums. Fixnums are handled more + ;; efficiently by the implementation, but some large integers can only be + ;; represented as bignums. + ;; Lisp converts between these two types on the fly. The constants + ;; MOST-NEGATIVE-FIXNUM and MOST-POSITIVE-FIXNUM describe the limits for + ;; fixnums. + (let ((integer-1 0) + (integer-2 most-positive-fixnum) + (integer-3 (1+ most-positive-fixnum)) + (integer-4 (1- most-negative-fixnum))) + (true-or-false? ____ (typep integer-1 'fixunm)) + (true-or-false? ____ (typep integer-1 'bignum)) + (true-or-false? ____ (typep integer-2 'fixnum)) + (true-or-false? ____ (typep integer-2 'bignum)) + (true-or-false? ____ (typep integer-3 'fixnum)) + (true-or-false? ____ (typep integer-3 'bignum)) + (true-or-false? ____ (typep integer-4 'fixnum)) + (true-or-false? ____ (typep integer-4 'bignum)) + ;; Regardless of whether an integer is a fixnum or a bignum, it is still + ;; an integer. + (true-or-false? ____ (typep integer-1 'integer)) + (true-or-false? ____ (typep integer-2 'integer)) + (true-or-false? ____ (typep integer-3 'integer)) + (true-or-false? ____ (typep integer-4 'integer)))) + +(define-test subtypep + (assert-true (typep 1 'bit)) + (assert-true (typep 1 'fixnum)) + (assert-true (typep 1 'integer)) + (assert-true (typep 2 'integer)) + ;; The function SUBTYPEP attempts to answer whether one type specifier + ;; represents a subtype of the other type specifier. + (true-or-false? ____ (subtypep 'bit 'integer)) + (true-or-false? ____ (subtypep (type-of 1) (type-of 2))) + (true-or-false? ____ (subtypep (type-of 2) (type-of 1)))) + +(define-test list-type-specifiers + ;; Some type specifiers are lists; this way, they carry more information than + ;; type specifiers which are symbols. + (assert-true (typep (make-array 0) '(vector * 0))) + (assert-true (typep (make-array 42) '(vector * 42))) + (assert-true (typep (make-array 42 :element-type 'bit) '(vector bit 42))) + (assert-true (typep (make-array '(4 2)) '(array * (4 2)))) + (true-or-false? ____ (typep (make-array '(3 3)) '(simple-array t (3 3)))) + (true-or-false? ____ (typep (make-array '(3 2 1)) '(simple-array t (1 2 3))))) + +(define-test list-type-specifiers-hierarchy + ;; Type specifiers that are lists also follow hierarchy. + (true-or-false? ____ (subtypep '(simple-array t (3 3)) '(simple-array t *))) + (true-or-false? ____ (subtypep '(vector double-float 100) '(vector * 100))) + (true-or-false? ____ (subtypep '(vector double-float 100) '(vector double-float *))) + (true-or-false? ____ (subtypep '(vector double-float 100) '(vector * *))) + (true-or-false? ____ (subtypep '(vector double-float 100) '(array number *))) + (true-or-false? ____ (subtypep '(vector double-float 100) t))) + +(define-test type-coercion + (assert-true (typep 0 'integer)) + (true-or-false? ____ (typep 0 'short-float)) + (true-or-false? ____ (subtypep 'integer 'short-float)) + (true-or-false? ____ (subtypep 'short-float 'integer)) + ;; The function COERCE makes it possible to convert values between some + ;; standard types. + (true-or-false? ____ (typep (coerce 0 'short-float) 'short-float))) + +(define-test atoms-are-anything-thats-not-a-cons + ;; In Lisp, an atom is anything that is not a cons cell. The function ATOM + ;; returns true if its object is an atom. + (true-or-false? ____ (atom 4)) + (true-or-false? ____ (atom '(1 2 3 4))) + (true-or-false? ____ (atom '(:foo . :bar))) + (true-or-false? ____ (atom 'symbol)) + (true-or-false? ____ (atom :keyword)) + (true-or-false? ____ (atom #(1 2 3 4 5))) + (true-or-false? ____ (atom #\A)) + (true-or-false? ____ (atom "string")) + (true-or-false? ____ (atom (make-array '(4 4))))) + +(define-test functionp + ;; The function FUNCTIONP returns true if its arguments is a function. + (assert-true (functionp (lambda (a b c) (+ a b c)))) + (true-or-false? ____ (functionp #'make-array)) + (true-or-false? ____ (functionp 'make-array)) + (true-or-false? ____ (functionp (lambda (x) (* x x)))) + (true-or-false? ____ (functionp '(lambda (x) (* x x)))) + (true-or-false? ____ (functionp '(1 2 3))) + (true-or-false? ____ (functionp t))) + +(define-test other-type-predicates + ;; Lisp defines multiple type predicates for standard types.. + (true-or-false? ____ (numberp 999)) + (true-or-false? ____ (listp '(9 9 9))) + (true-or-false? ____ (integerp 999)) + (true-or-false? ____ (rationalp 9/99)) + (true-or-false? ____ (floatp 9.99)) + (true-or-false? ____ (stringp "nine nine nine")) + (true-or-false? ____ (characterp #\9)) + (true-or-false? ____ (bit-vector-p #*01001))) + +(define-test guess-that-type + ;; Fill in the blank with a type specifier that satisfies the following tests. + (let ((type ____)) + (assert-true (subtypep type '(simple-array t (* 3 *)))) + (assert-true (subtypep type '(simple-array t (5 * *)))) + (assert-true (subtypep type '(simple-array array *))) + (assert-true (typep (make-array '(5 3 9) :element-type 'string) type)) + (assert-true (typep (make-array '(5 3 33) :element-type 'vector) type)))) diff --git a/koans-solved/variables-parameters-constants.lisp b/koans-solved/variables-parameters-constants.lisp new file mode 100644 index 00000000..ca960376 --- /dev/null +++ b/koans-solved/variables-parameters-constants.lisp @@ -0,0 +1,88 @@ +;; Copyright 2013 Google Inc. +;; +;; Licensed under the Apache License, Version 2.0 (the "License"); +;; you may not use this file except in compliance with the License. +;; You may obtain a copy of the License at +;; +;; http://www.apache.org/licenses/LICENSE-2.0 +;; +;; Unless required by applicable law or agreed to in writing, software +;; distributed under the License is distributed on an "AS IS" BASIS, +;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;; See the License for the specific language governing permissions and +;; limitations under the License. + +(defun test-variable-assignment-with-setf () + ;; the let pattern allows us to create local variables with + ;; lexical scope. + (let (var_name_1 (var_name_2 "Michael")) + ;; variables may be defined with or without initial values. + (and + (equalp var_name_2 "Michael") + ; new values may be assigned to variables with setf + (setf var_name_2 "Janet") + (equalp var_name_2 "Janet") + ; setf may assign multiple variables in one form. + (setf var_name_1 "Tito" + var_name_2 "Jermaine") + (equalp var_name_1 "Tito") + (equalp var_name_2 "Jermaine")))) + +(defun test-setf-for-lists () + ;; setf also works on list elements + (let (l) + (setf l '(1 2 3)) + (equalp l '(1 2 3)) + ; First second and third are convenient accessor functions + ; referring to the elements of a list + ; For those interested, they are convenient to car, cadr, and caddr + (setf (first l) 10) + (setf (second l) 20) + (setf (third l) 30) + (equalp l '(10 20 30)))) + +(defparameter param_name_1 "Janet") +; defparameter requires an initial form. It is a compiler error to exclude it +;(defparameter param_no_init) ;; this will fail +(defconstant additive_identity 0) +; defconstant also requires an initial form +; (defconstant constant_no_init) + +; reassigning parameters to new values is also ok, but parameters carry the +; connotation of immutability. If it's going to change frequently, it should +; be a var. +(setf param_name_1 "The other one") + +; reassigning a constant is an error. +; this should result in a compile time error +; (setf additive_identity -1) + + +;; ------------------------------- +;; below is necessary to run tests. +;; ------------------------------- + +(defvar failed-test-names nil) + +(defun run-test (testfun) + (let ((fun-name (function-name testfun))) + (if (apply testfun '()) + (format t ".") + (progn + (setf failed-test-names (cons fun-name failed-test-names)) + (format t "F"))))) + +(defun function-name (function) (nth-value 2 (function-lambda-expression function))) + + +(run-test #'test-variable-assignment-with-setf) +(run-test #'test-setf-for-lists) + +(format t "~%") + +(defun report-failure (test-name) + (format t "~S failed.~%" test-name)) + +(if (endp failed-test-names) ; no failed tests + (format t "all tests pass.~%") + (mapcar #'report-failure failed-test-names)) \ No newline at end of file diff --git a/koans-solved/vectors.lisp b/koans-solved/vectors.lisp new file mode 100644 index 00000000..32b4eec4 --- /dev/null +++ b/koans-solved/vectors.lisp @@ -0,0 +1,54 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; Vectors are one-dimensional arrays. This means that general array operations +;;; will work on vectors normally. However, Lisp also defines some functions for +;;; operating on sequences - which means, either vectors or lists. + +(define-test vector-basics + ;; #(...) is syntax sugar for defining literal vectors. + (let ((vector #(1 11 111))) + (true-or-false? t (typep vector 'vector)) + (assert-equal 11 (aref vector 1)))) + +(define-test length + ;; The function LENGTH works both for vectors and for lists. + (assert-equal 3 (length '(1 2 3))) + (assert-equal 3 (length #(1 2 3)))) + +(define-test bit-vector + ;; #*0011 defines a bit vector literal with four elements: 0, 0, 1 and 1. + (assert-equal #*0011 (make-array 4 :element-type 'bit + :initial-contents '(0 0 1 1))) + (true-or-false? t (typep #*1001 'bit-vector)) + (assert-equal 0 (aref #*1001 1))) + +(define-test bitwise-operations + ;; Lisp defines a few bitwise operations that work on bit vectors. + (assert-equal #*1000 (bit-and #*1100 #*1010)) + (assert-equal #*1110 (bit-ior #*1100 #*1010)) + (assert-equal #*0110 (bit-xor #*1100 #*1010))) + +(defun list-to-bit-vector (list) + ;; Implement a function that turns a list into a bit vector. + (coerce list 'bit-vector)) + +(define-test list-to-bit-vector + ;; You need to fill in the blank in LIST-TO-BIT-VECTOR. + (assert-true (typep (list-to-bit-vector '(0 0 1 1 0)) 'bit-vector)) + (assert-equal (aref (list-to-bit-vector '(0)) 0) 0) + (assert-equal (aref (list-to-bit-vector '(0 1)) 1) 1) + (assert-equal (length (list-to-bit-vector '(0 0 1 1 0 0 1 1))) 8)) + + diff --git a/koans/arrays.lisp b/koans/arrays.lisp index bbb9d67f..788abeee 100644 --- a/koans/arrays.lisp +++ b/koans/arrays.lisp @@ -37,7 +37,7 @@ ;; You may need to modify your array after you create it. (setf (____ color-cube ____ ____ ____) ____ (____ color-cube ____ ____ ____) ____) - (if (typep color-cube '(simple-array T (3 3 3))) + (if (typep color-cube '(simple-array t (3 3 3))) (progn (assert-equal 3 (array-rank color-cube)) (assert-equal '(3 3 3) (array-dimensions color-cube)) diff --git a/koans/basic-macros.lisp b/koans/basic-macros.lisp index 28412c7f..d5b14c9e 100644 --- a/koans/basic-macros.lisp +++ b/koans/basic-macros.lisp @@ -62,9 +62,9 @@ (define-test special-cases-of-case ;; You need to fill in the blanks in MATCH-SPECIAL-CASES. - (assert-equal :found-a-t (case-special-symbols-match t)) - (assert-equal :found-a-nil (case-special-symbols-match nil)) - (assert-equal :something-else (case-special-symbols-match 42))) + (assert-equal :found-a-t (match-special-cases t)) + (assert-equal :found-a-nil (match-special-cases nil)) + (assert-equal :something-else (match-special-cases 42))) (define-test your-own-case-statement ;; We use FLET to define a local function. @@ -87,22 +87,18 @@ ;; from EQUAL. ;; EQL is suitable for comparing numbers, characters, and objects for whom we ;; want to check verify they are the same object. - (let ((string "A string") - (string-copy (copy-seq string))) + (let* ((string "A string") + (string-copy (copy-seq string))) ;; The above means that two distinct strings will not be the same under EQL, ;; even if they have the same contents. (true-or-false? ____ (eql string string-copy)) (true-or-false? ____ (equal string string-copy)) ;; The above also means that CASE might give surprising results when used on ;; strings. - (let ((match-1 (case string - (string-copy :matched) - (t :not-matched))) - (match-2 (case string - (string :matched) - (t :not-matched)))) - (assert-equal ____ match-1) - (assert-equal ____ match-2)) + (let ((match (case string + ("A string" :matched) + (t :not-matched)))) + (assert-equal ____ match)) ;; We will explore this topic further in the EQUALITY-DISTINCTIONS lesson. )) diff --git a/koans/evaluation.lisp b/koans/evaluation.lisp index 176b3187..ef0e7a5a 100644 --- a/koans/evaluation.lisp +++ b/koans/evaluation.lisp @@ -34,7 +34,7 @@ ;; Arguments to a function are evaluated before the function is called. (assert-equal ____ (* (+ 1 2) (- 13 10)))) -(define-test basic-arithmetic +(define-test basic-comparisons ;; The below functions are boolean functions (predicates) that operate on ;; numbers. (assert-equal ____ (> 25 4)) diff --git a/koans/functions.lisp b/koans/functions.lisp index c691362d..ae8b6a93 100644 --- a/koans/functions.lisp +++ b/koans/functions.lisp @@ -27,7 +27,7 @@ (if (or (= 0 a) (= 0 b)) 1 (+ (* a b) (recursive-function (1- a) (1- b)))))) - (assert-equal ____ (different-named-function 4 5)))) + (assert-equal ____ (recursive-function 4 5)))) (define-test shadow-a-function (assert-eq 18 (some-named-function 7 11)) @@ -75,11 +75,11 @@ (assert-equal ____ (function-with-keyword-parameters)) (assert-equal ____ (function-with-keyword-parameters :a 11 :b 22 :c 33)) ;; It is not necessary to specify all keyword parameters. - (assert-equal ____ (func-with-key-params :b 22)) + (assert-equal ____ (function-with-keyword-parameters :b 22)) ;; Keyword argument order is not important. - (assert-equal ____ (func-with-key-params :b 22 :c -5/2 :a 0)) + (assert-equal ____ (function-with-keyword-parameters :b 22 :c -5/2 :a 0)) ;; Lisp handles duplicate keyword parameters. - (assert-equal ____ (func-with-key-params :b 22 :b 40 :b 812))) + (assert-equal ____ (function-with-keyword-parameters :b 22 :b 40 :b 812))) (defun function-with-keyword-indication (&key (a 2 a-provided-p) (b 3 b-provided-p)) @@ -99,10 +99,10 @@ (list a b c c-provided-p x)) (define-test funky-parameters - (assert-equal (func-with-funky-parameters 1) ___) - (assert-equal (func-with-funky-parameters 1 :b 2) ___) - (assert-equal (func-with-funky-parameters 1 :b 2 :c 3) ___) - (assert-equal (func-with-funky-parameters 1 :c 3 :b 2) ___)) + (assert-equal ____ (function-with-funky-parameters 1)) + (assert-equal ____ (function-with-funky-parameters 1 :b 2)) + (assert-equal ____ (function-with-funky-parameters 1 :b 2 :c 3)) + (assert-equal ____ (function-with-funky-parameters 1 :c 3 :b 2))) (define-test lambda ;; A list form starting with the symbol LAMBDA denotes an anonymous function. @@ -148,14 +148,14 @@ ;; listed in its first argument to the parts of the list returned by the form ;; that is its second argument. (destructuring-bind (reader-1 writer-1) (make-reader-and-writer 1) - (destructuring-bind (reader-2 writer-2) (make-reader-and-writer :one)) - (assert-equal ____ (funcall reader-1)) - (funcall writer-1 0) - (assert-equal ____ (funcall reader-1)) - ;; The two different function pairs refer to different places. - (assert-equal ____ (funcall reader-2)) - (funcall writer-2 :zero) - (assert-equal ____ (funcall reader-2)))) + (destructuring-bind (reader-2 writer-2) (make-reader-and-writer :one) + (assert-equal ____ (funcall reader-1)) + (funcall writer-1 0) + (assert-equal ____ (funcall reader-1)) + ;; The two different function pairs refer to different places. + (assert-equal ____ (funcall reader-2)) + (funcall writer-2 :zero) + (assert-equal ____ (funcall reader-2))))) (define-test apply ;; The function APPLY applies a function to a list of arguments. diff --git a/koans/hash-tables.lisp b/koans/hash-tables.lisp index 2396f467..d5a7b89d 100644 --- a/koans/hash-tables.lisp +++ b/koans/hash-tables.lisp @@ -53,14 +53,14 @@ (equal-table (make-hash-table :test #'equal)) (equalp-table (make-hash-table :test #'equalp))) ;; We will define four variables whose values are strings. - (let ((string "one") - (same-string string) - (string-copy (copy-string string)) - (string-upcased "ONE"))) - ;; We will insert the value of each variable into each hash table. - (dolist (thing (list string same-string string-copy string-upcased)) - (dolist (hash-table (list eq-table eql-table equal-table equalp-table)) - (setf (gethash string hash-table) t))) + (let* ((string "one") + (same-string string) + (string-copy (copy-seq string)) + (string-upcased "ONE")) + ;; We will insert the value of each variable into each hash table. + (dolist (thing (list string same-string string-copy string-upcased)) + (dolist (hash-table (list eq-table eql-table equal-table equalp-table)) + (setf (gethash thing hash-table) t)))) ;; How many entries does each hash table contain? (assert-equal ____ (hash-table-count eq-table)) (assert-equal ____ (hash-table-count eql-table)) diff --git a/koans/lists.lisp b/koans/lists.lisp index ac3d9a52..4ed0946a 100644 --- a/koans/lists.lisp +++ b/koans/lists.lisp @@ -23,7 +23,7 @@ ;; Freshly constructed lists can be passed using the LIST function. (some-evens (list (* 2 1) (* 2 2) (* 2 3))) ;; Lists can also be passed using quotes and dot notation... - (long-numbers '(16487302 . (3826700034 . (10000000 . '())))) + (long-numbers '(16487302 . (3826700034 . (10000000 . nil)))) ;; ...or by using the function CONS. (names (cons "Matthew" (cons "Mark" (cons "Margaret" '()))))) ;; Try filling in the below blanks in different ways. @@ -56,13 +56,13 @@ ;; Calls to CAR and CDR are often intertwined to extract data from a nested ;; cons structure. (let ((structure '((1 2) (("foo" . "bar"))))) - (assert-equal ____ (car x)) - (assert-equal ____ (car (cdr x))) - (assert-equal ____ (cdr (car (car (cdr x))))) + (assert-equal ____ (car structure)) + (assert-equal ____ (car (cdr structure))) + (assert-equal ____ (cdr (car (car (cdr structure))))) ;; Lisp defines shorthand functions for up to four such nested calls. - (assert-equal ____ (car x)) - (assert-equal ____ (cadr x)) - (assert-equal ____ (cdaadr x)))) + (assert-equal ____ (car structure)) + (assert-equal ____ (cadr structure)) + (assert-equal ____ (cdaadr structure)))) (define-test push-pop ;; PUSH and POP are macros similar to SETF, as both of them operate on places. @@ -123,7 +123,7 @@ ;; ...or pass them as literals via dot notation. (y '(6 7 8 9 . 0))) (assert-equal ____ (last x)) - (assert-equal ____ (list y))) + (assert-equal ____ (last y))) ;; We can create a cyclic list by changing the last CDR of a list to refer to ;; another cons cell (let ((list (list 1 2 3 4 5)) diff --git a/koans/scope-and-extent.lisp b/koans/scope-and-extent.lisp index ac55459f..7b5ae1b0 100644 --- a/koans/scope-and-extent.lisp +++ b/koans/scope-and-extent.lisp @@ -28,8 +28,8 @@ (return-from outer 'valve))) (define-test block-return-from - (assert-equal ____ (block-01)) - (assert-equal ____ (block-02))) + (assert-equal ____ (block-1)) + (assert-equal ____ (block-2))) ;;; See http://www.gigamonkeys.com/book/variables.html diff --git a/koans/structures.lisp b/koans/structures.lisp index e6c89c38..42f88efd 100644 --- a/koans/structures.lisp +++ b/koans/structures.lisp @@ -28,7 +28,8 @@ name team number) (define-test make-struct - (let ((player (make-basketball-player :name "Larry" :team :celtics :number 33))) + (let ((player (make-basketball-player :name "Larry" :team :celtics + :number 33))) (true-or-false? ____ (basketball-player-p player)) (assert-equal ____ (basketball-player-name player)) (assert-equal ____ (basketball-player-team player)) @@ -96,9 +97,15 @@ (let ((manning-3 (copy-american-football-player manning-1))) (true-or-false? ____ (eq manning-1 manning-3)) (true-or-false? ____ (equalp manning-1 manning-3)) - ;; Setting the slot of one instance does not modify the others. + ;; Setting the slot of one instance does not modify the others... + (setf (nfl-guy-name manning-1) "Rogers") + (true-or-false? ____ (string= (nfl-guy-name manning-1) + (nfl-guy-name manning-3))) + (assert-equal ____ (nfl-guy-name manning-1)) + (assert-equal ____ (nfl-guy-name manning-3)) + ;; ...but modifying shared structure may affect other instances. (setf (car (nfl-guy-team manning-1)) "Giants") (true-or-false? ____ (string= (car (nfl-guy-team manning-1)) (car (nfl-guy-team manning-3)))) (assert-equal ____ (car (nfl-guy-team manning-1))) - (assert-equal ____ (car (nfl-guy-team manning-1)))))) + (assert-equal ____ (car (nfl-guy-team manning-3)))))) diff --git a/lisp-koans.lisp b/lisp-koans.lisp index 895113e3..ce8300d4 100644 --- a/lisp-koans.lisp +++ b/lisp-koans.lisp @@ -30,7 +30,7 @@ (defun package-name-from-group-name (group-name) (format nil "COM.GOOGLE.LISP-KOANS.KOANS.~A" group-name)) -(defun load-koan-group-named (koan-group-name) +(defun load-koan-group-named (dirname koan-group-name) (let* ((koan-name (string-downcase (string koan-group-name))) (koan-file-name (concatenate 'string koan-name ".lisp")) (koan-package-name (package-name-from-group-name koan-group-name))) @@ -38,11 +38,11 @@ (make-package koan-package-name :use '(#:common-lisp #:com.google.lisp-koans.test))) (let ((*package* (find-package koan-package-name))) - (load (concatenate 'string "koans/" koan-file-name))))) + (load (concatenate 'string dirname "/" koan-file-name))))) -(defun load-all-koans () +(defun load-all-koans (dirname) (loop for koan-group-name in *all-koan-groups* - do (load-koan-group-named koan-group-name))) + do (load-koan-group-named dirname koan-group-name))) ;;; Functions for executing koans @@ -62,8 +62,8 @@ (dolist (result (reverse results)) (destructuring-bind (test-name results) result (let ((format-control (if (every (lambda (x) (equalp :pass x)) results) - " ~A has expanded your awareness.~%~%" - " ~A requires more meditation.~%~%"))) + " ~A has expanded your awareness.~%" + " ~A requires more meditation.~%"))) (format t format-control test-name))))) ;;; Functions for processing results @@ -89,17 +89,17 @@ ((find :error koan-status) "A koan signaled an error.") (t (format nil "Last koan status: ~A." koan-status)))) -(defun print-next-suggestion-message () +(defun print-next-suggestion-message (dirname) (let ((filename (caar *collected-results*)) (koan-name (caaadr (car (last (last *collected-results*))))) (koan-status (reverse (cadaar (cdar (last (last *collected-results*))))))) - (format t "You have not yet reached enlightenment. + (format t "~&You have not yet reached enlightenment. ~A Please meditate on the following code: - File \"koans/~(~A~).lisp\" + File \"~A/~(~A~).lisp\" Koan \"~A\" Current koan assert status is \"~A\"~%~%" - (koan-status-message koan-status) filename koan-name koan-status))) + (koan-status-message koan-status) dirname filename koan-name koan-status))) (defun print-completion-message () (format t "********************************************************* @@ -118,15 +118,15 @@ Write and submit your own improvements to https://github.com/google/lisp-koans! (1- (length *collected-results*)) (length *all-koan-groups*))) -(defun output-advice () +(defun output-advice (dirname) (cond ((any-assert-non-pass-p) - (print-next-suggestion-message) + (print-next-suggestion-message dirname) (print-progress-message)) (t (print-completion-message)))) ;;; Main -(defun main () - (load-all-koans) +(defun main (&optional (dirname "koans")) + (load-all-koans dirname) (execute-koans) - (output-advice)) + (output-advice dirname)) diff --git a/test-framework.lisp b/test-framework.lisp index 0c1afcf2..718ce5ad 100644 --- a/test-framework.lisp +++ b/test-framework.lisp @@ -92,7 +92,7 @@ (defun test-passed-p (type expected actual test) (ecase type (:error (or (eql (car actual) (car expected)) (typep (car actual) (car expected)))) - (:equal (and (<= (length expected) (length actual)) (every test expected actual))) + (:equal (and (>= (length expected) (length actual)) (every test expected actual))) (:macro (equal (car actual) (car expected))) (:result (eql (not (car actual)) (not (car expected)))))) @@ -138,7 +138,7 @@ (defmacro true-or-false? (form expected) "Assert whether expected and form are logically equivalent." - `(expand-assert :equal ,form (notnot ,form) ,(notnot expected) :test #'eql)) + `(expand-assert :equal ,form (notnot ,form) (notnot ,expected) :test #'eql)) (defmacro assert-error (form condition) "Assert whether form signals condition." diff --git a/test.lisp b/test.lisp new file mode 100644 index 00000000..dbca2fb2 --- /dev/null +++ b/test.lisp @@ -0,0 +1,29 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +(in-package :cl-user) + +;;; Though Clozure / CCL runs lisp-koans on the command line using +;;; "ccl -l contemplate.lisp", the following lines are needed to +;;; meditate on the koans within the CCL IDE. +;;; (The :hemlock is used to distiguish between ccl commandline and the IDE) +#+(and :ccl :hemlock) +(setf *default-pathname-defaults* (directory-namestring *load-pathname*)) + +(load "test-framework.lisp") +(load "lisp-koans.lisp") + +#+quicklisp (ql:quickload :bordeaux-threads) + +(com.google.lisp-koans:main "koans-solved")