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

pulled in lisp koans for solving

Browse Source 
https://github.com/google/lisp-koans
This commit is contained in:
efim
2022-07-24 12:13:42 +00:00
parent fe0950582d
commit 49c00c24ee
104 changed files with 8515 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

72
lisp-koans/koans-solved/arrays.lisp Normal file
View File

@@ -0,0 +1,72 @@
;;; Copyright 2013 Google Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
(define-test basic-array-stuff
;; We make an 8x8 array and then fill it with a checkerboard pattern.
(let ((chess-board (make-array '(8 8))))
;; (DOTIMES (X 8) ...) will iterate with X taking values from 0 to 7.
(dotimes (x 8)
(dotimes (y 8)
;; AREF stands for "array reference".
(setf (aref chess-board x y) (if (evenp (+ x y)) :black :white))))
(assert-true (typep chess-board 'array))
(assert-equal :black (aref chess-board 0 0))
(assert-equal :white (aref chess-board 2 3))
;; The function ARRAY-RANK returns the number of dimensions of the array.
(assert-equal 2 (array-rank chess-board))
;; The function ARRAY-DIMENSIONS returns a list of the cardinality of the
;; array dimensions.
(assert-equal '(8 8) (array-dimensions chess-board))
;; ARRAY-TOTAL-SIZE returns the total number of elements in the array.
(assert-equal 64 (array-total-size chess-board))))
(define-test make-your-own-array
;; Make your own array that satisfies the test.
(let ((color-cube (make-array '(3 3 3))))
;; You may need to modify your array after you create it.
(setf (aref color-cube 0 1 2) :red
(aref color-cube 2 1 0) :white)
(if (typep color-cube '(simple-array T (3 3 3)))
(progn
(assert-equal 3 (array-rank color-cube))
(assert-equal '(3 3 3) (array-dimensions color-cube))
(assert-equal 27 (array-total-size color-cube))
(assert-equal (aref color-cube 0 1 2) :red)
(assert-equal (aref color-cube 2 1 0) :white))
(assert-true nil))))
(define-test adjustable-array
;; The size of an array does not need to be constant.
(let ((x (make-array '(2 2) :initial-element 5 :adjustable t)))
(assert-equal 5 (aref x 1 0))
(assert-equal '(2 2) (array-dimensions x))
(adjust-array x '(3 4))
(assert-equal '(3 4) (array-dimensions x))))
(define-test make-array-from-list
;; One can create arrays with initial contents.
(let ((x (make-array '(4) :initial-contents '(:one :two :three :four))))
(assert-equal '(4) (array-dimensions x))
(assert-equal :one (aref x 0))))
(define-test row-major-index
;; Row major indexing is a way to access elements with a single integer,
;; rather than a list of integers.
(let ((my-array (make-array '(2 2 2 2))))
(dotimes (i (* 2 2 2 2))
(setf (row-major-aref my-array i) i))
(assert-equal 0 (aref my-array 0 0 0 0))
(assert-equal 2 (aref my-array 0 0 1 0))
(assert-equal 4 (aref my-array 0 1 0 0))
(assert-equal 15 (aref my-array 1 1 1 1))))

65
lisp-koans/koans-solved/asserts.lisp Normal file
View File

@@ -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))))

43
lisp-koans/koans-solved/atoms-vs-lists.lisp Normal file
View File

@@ -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)))

71
lisp-koans/koans-solved/backquote.lisp Normal file
View File

@@ -0,0 +1,71 @@
;;; Copyright 2013 Google Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; Backquote notation is similar to quoting, except it allows for parts of the
;;; resulting expression to be "unquoted".
(define-test backquote-basics
(let ((x '(123))
(z '(7 8 9)))
;; ' quotes an expression normally.
(assert-equal '(x 45 6 z) '(x 45 6 z))
;; ` backquotes an expression; without any unquotes, it is equivalent to
;; using the normal quote.
(assert-equal '(x 45 6 z) `(x 45 6 z))
;; , unquotes a part of the expression.
(assert-equal '((123) 45 6 z) `(,x 45 6 z))
(assert-equal '((123) 45 6 (7 8 9)) `(,x 45 6 ,z))
;; ,@ splices an expression into the into the list surrounding it.
(assert-equal '((123) 45 6 7 8 9) `(,x 45 6 ,@z))
(assert-equal '(123 45 6 7 8 9) `(,@x 45 6 ,@z))))
(define-test backquote-forms
;; Because of its properties, backquote is useful for constructing Lisp forms
;; that are macroexpansions or parts of macroexpansions.
(let ((variable 'x))
;; Fill in the blank without without using backquote/unquote notation.
(assert-equal '(if (typep x 'string)
(format nil "The value of ~A is ~A" 'x x)
(error 'type-error :datum x :expected-type 'string))
`(if (typep ,variable 'string)
(format nil "The value of ~A is ~A" ',variable ,variable)
(error 'type-error :datum ,variable
:expected-type 'string))))
(let ((error-type 'type-error)
(error-arguments '(:datum x :expected-type 'string)))
;; Fill in the blank without without using backquote/unquote notation.
(assert-equal '(if (typep x 'string)
(format nil "The value of ~A is ~A" 'x x)
(error 'type-error :datum x :expected-type 'string))
`(if (typep x 'string)
(format nil "The value of ~A is ~A" 'x x)
(error ',error-type ,@error-arguments)))))
(define-test numbers-and-words
(let ((number 5)
(word 'dolphin))
(true-or-false? t (equal '(1 3 5) `(1 3 5)))
(true-or-false? nil (equal '(1 3 5) `(1 3 number)))
(assert-equal '(1 3 5) `(1 3 ,number))
(assert-equal '(word dolphin dolphin word) `(word ,word ,word word))))
(define-test splicing
(let ((axis '(x y z)))
(assert-equal '(the axis are (x y z)) `(the axis are ,axis))
(assert-equal '(the axis are x y z) `(the axis are ,@axis)))
(let ((coordinates '((43.15 77.6) (42.36 71.06))))
(assert-equal '(the coordinates are ((43.15 77.6) (42.36 71.06)))
`(the coordinates are ,coordinates))
(assert-equal '(the coordinates are (43.15 77.6) (42.36 71.06))
`(the coordinates are ,@coordinates))))

112
lisp-koans/koans-solved/basic-macros.lisp Normal file
View File

@@ -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)))

181
lisp-koans/koans-solved/clos.lisp Normal file
View File

@@ -0,0 +1,181 @@
;;; Copyright 2013 Google Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; CLOS is a shorthand for Common Lisp Object System.
(defclass racecar ()
;; A class definition lists all the slots of every instance.
(color speed))
(define-test defclass
;; Class instances are constructed via MAKE-INSTANCE.
(let ((car-1 (make-instance 'racecar))
(car-2 (make-instance 'racecar)))
;; Slot values can be set via SLOT-VALUE.
(setf (slot-value car-1 'color) :red)
(setf (slot-value car-1 'speed) 220)
(setf (slot-value car-2 'color) :blue)
(setf (slot-value car-2 'speed) 240)
(assert-equal :red (slot-value car-1 'color))
(assert-equal 240 (slot-value car-2 'speed))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Common Lisp predefines the symbol SPEED in the COMMON-LISP package, which
;;; means that we cannot define a function named after it. The function SHADOW
;;; creates a new symbol with the same name in the current package and shadows
;;; the predefined one within the current package.
(shadow 'speed)
(defclass spaceship ()
;; It is possible to define reader, writer, and accessor functions for slots.
((color :reader color :writer (setf color))
(speed :accessor speed)))
;;; Specifying a reader function named COLOR is equivalent to
;;; (DEFMETHOD COLOR ((OBJECT SPACECSHIP)) ...)
;;; Specifying a writer function named (SETF COLOR) is equivalent to
;;; (DEFMETHOD (SETF COLOR) (NEW-VALUE (OBJECT SPACECSHIP)) ...)
;;; Specifying an accessor function performs both of the above.
(define-test accessors
(let ((ship (make-instance 'spaceship)))
(setf (color ship) :orange
(speed ship) 1000)
(assert-equal :orange (color ship))
(assert-equal 1000 (speed ship))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass bike ()
;; It is also possible to define initial arguments for slots.
((color :reader color :initarg :color)
(speed :reader speed :initarg :speed)))
(define-test initargs
(let ((bike (make-instance 'bike :color :blue :speed 30)))
(assert-equal :blue (color bike))
(assert-equal 30 (speed bike))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Lisp classes can inherit from one another.
(defclass person ()
((name :initarg :name :accessor person-name)))
(defclass lisp-programmer (person)
((favorite-lisp-implementation :initarg :favorite-lisp-implementation
:accessor favorite-lisp-implementation)))
(defclass c-programmer (person)
((favorite-c-compiler :initarg :favorite-c-compiler
:accessor favorite-c-compiler)))
(define-test inheritance
(let ((jack (make-instance 'person :name :jack))
(bob (make-instance 'lisp-programmer
:name :bob
:favorite-lisp-implementation :sbcl))
(adam (make-instance 'c-programmer
:name :adam
:favorite-c-compiler :clang)))
(assert-equal :jack (person-name jack))
(assert-equal :bob (person-name bob))
(assert-equal :sbcl (favorite-lisp-implementation bob))
(assert-equal :adam (person-name adam))
(assert-equal :clang (favorite-c-compiler adam))
(true-or-false? t (typep bob 'person))
(true-or-false? t (typep bob 'lisp-programmer))
(true-or-false? nil (typep bob 'c-programmer))))
;;; This includes multiple inheritance.
(defclass clisp-programmer (lisp-programmer c-programmer) ())
(define-test multiple-inheritance
(let ((zenon (make-instance 'clisp-programmer
:name :zenon
:favorite-lisp-implementation :clisp
:favorite-c-compiler :gcc)))
(assert-equal :zenon (person-name zenon))
(assert-equal :clisp (favorite-lisp-implementation zenon))
(assert-equal :gcc (favorite-c-compiler zenon))
(true-or-false? t (typep zenon 'person))
(true-or-false? t (typep zenon 'lisp-programmer))
(true-or-false? t (typep zenon 'c-programmer))
(true-or-false? t (typep zenon 'clisp-programmer))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Multiple inheritance makes it possible to work with mixin classes.
(defclass greeting-mixin ()
((greeted-people :accessor greeted-people :initform '())))
(defgeneric greet (greeter greetee))
(defmethod greet ((object greeting-mixin) name)
;; PUSHNEW is similar to PUSH, but it does not modify the place if the object
;; we want to push is already found on the list in the place.
(pushnew name (greeted-people object) :test #'equal)
(format nil "Hello, ~A." name))
(defclass chatbot ()
((version :reader version :initarg :version)))
(defclass greeting-chatbot (greeting-mixin chatbot) ())
(define-test greeting-chatbot ()
(let ((chatbot (make-instance 'greeting-chatbot :version "1.0.0")))
(true-or-false? t (typep chatbot 'greeting-mixin))
(true-or-false? t (typep chatbot 'chatbot))
(true-or-false? t (typep chatbot 'greeting-chatbot))
(assert-equal "Hello, Tom." (greet chatbot "Tom"))
(assert-equal '("Tom") (greeted-people chatbot))
(assert-equal "Hello, Sue." (greet chatbot "Sue"))
(assert-equal "Hello, Mark." (greet chatbot "Mark"))
(assert-equal "Hello, Kate." (greet chatbot "Kate"))
(assert-equal "Hello, Mark." (greet chatbot "Mark"))
(assert-equal '("Kate" "Mark" "Sue" "Tom") (greeted-people chatbot))
(assert-equal "1.0.0" (version chatbot))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass american (person) ())
(defclass italian (person) ())
(defgeneric stereotypical-food (person)
;; The :METHOD option in DEFGENERIC is an alternative to DEFMETHOD.
(:method ((person italian)) :pasta)
(:method ((person american)) :burger))
;;; When methods or slot definitions of superclasses overlap with each other,
;;; the order of superclasses is used to resolve the conflict.
(defclass stereotypical-person (american italian) ())
(defclass another-stereotypical-person (italian american) ())
(define-test stereotypes
(let ((james (make-instance 'american))
(antonio (make-instance 'italian))
(roy (make-instance 'stereotypical-person))
(mary (make-instance 'another-stereotypical-person)))
(assert-equal :burger (stereotypical-food james))
(assert-equal :pasta (stereotypical-food antonio))
(assert-equal :burger (stereotypical-food roy))
(assert-equal :pasta (stereotypical-food mary))))

279
lisp-koans/koans-solved/condition-handlers.lisp Normal file
View File

@@ -0,0 +1,279 @@
;;; Copyright 2013 Google Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; Lisp condition types are very similar to classes. The standard specifies
;;; multiple standard condition types: among them, CONDITION, WARNING,
;;; SERIOUS-CONDITION, and ERROR.
;;; The type CONDITION is the base type of all condition objects.
(define-condition my-condition () ())
;;; The type WARNING is the base type of all conditions of which the programmer
;;; should be warned, unless the condition is somehow handled by the program.
(define-condition my-warning (warning) ())
;;; The type SERIOUS-CONDITION includes programming errors and other situations
;;; where computation cannot proceed (e.g. due to memory or storage issues).
(define-condition my-serious-condition (serious-condition) ())
;;; The type ERROR is the base type for all error situations in code.
(define-condition my-error (error) ())
(define-test type-hierarchy
;; Inheritance for condition types works the same way as for classes.
(let ((condition (make-condition 'my-condition)))
(true-or-false? t (typep condition 'my-condition))
(true-or-false? t (typep condition 'condition))
(true-or-false? nil (typep condition 'warning))
(true-or-false? nil (typep condition 'error)))
(let ((condition (make-condition 'my-warning)))
(true-or-false? t (typep condition 'my-warning))
(true-or-false? t (typep condition 'warning))
(true-or-false? nil (typep condition 'error)))
(let ((condition (make-condition 'my-serious-condition)))
(true-or-false? t (typep condition 'my-serious-condition))
(true-or-false? t (typep condition 'serious-condition))
(true-or-false? nil (typep condition 'warning))
(true-or-false? nil (typep condition 'error)))
(let ((condition (make-condition 'my-error)))
(true-or-false? t (typep condition 'my-error))
(true-or-false? nil (typep condition 'my-serious-condition))
(true-or-false? t (typep condition 'serious-condition))
(true-or-false? nil (typep condition 'warning))
(true-or-false? t (typep condition 'error))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; A condition handler is composed of a handler function that accepts a
;;; condition object and a condition type for which the function will be called.
(defvar *list*)
(define-condition silly-condition () ())
(define-condition very-silly-condition (silly-condition) ())
(define-condition most-silly-condition (very-silly-condition) ())
(defun handle-silly-condition (condition)
(declare (ignore condition))
(push :silly-condition *list*))
(defun handle-very-silly-condition (condition)
(declare (ignore condition))
(push :very-silly-condition *list*))
(defun handle-most-silly-condition (condition)
(declare (ignore condition))
(push :most-silly-condition *list*))
(define-test handler-bind
;; When a condition is signaled, all handlers whose type matches the
;; condition's type are allowed to execute.
(let ((*list* '()))
(handler-bind ((very-silly-condition #'handle-very-silly-condition)
(silly-condition #'handle-silly-condition)
(most-silly-condition #'handle-most-silly-condition))
(signal (make-condition 'most-silly-condition)))
(assert-equal '(:most-silly-condition
:silly-condition
:very-silly-condition)
*list*)))
(define-test handler-order
;; The order of binding handlers matters.
(let ((*list* '()))
(handler-bind ((silly-condition #'handle-silly-condition)
(very-silly-condition #'handle-very-silly-condition)
(most-silly-condition #'handle-most-silly-condition))
(signal (make-condition 'most-silly-condition)))
(assert-equal '(:most-silly-condition
:very-silly-condition
:silly-condition)
*list*)))
(define-test multiple-handler-binds
;; It is possible to bind handlers in steps.
(let ((*list* '()))
(handler-bind ((silly-condition #'handle-silly-condition)
(most-silly-condition #'handle-most-silly-condition))
(handler-bind ((very-silly-condition #'handle-very-silly-condition))
(signal (make-condition 'most-silly-condition))))
(assert-equal '(:most-silly-condition
:silly-condition
:very-silly-condition)
*list*)))
(define-test same-handler
;; The same handler may be bound multiple times.
(let ((*list* '()))
(handler-bind ((silly-condition #'handle-silly-condition)
(silly-condition #'handle-silly-condition))
(handler-bind ((very-silly-condition #'handle-very-silly-condition)
(silly-condition #'handle-silly-condition)
(very-silly-condition #'handle-very-silly-condition))
(signal (make-condition 'most-silly-condition))))
(assert-equal '(:silly-condition
:silly-condition
:very-silly-condition
:silly-condition
:very-silly-condition)
*list*)))
(define-test handler-types
;; A handler is not executed if it does not match the condition type.
(let ((*list* '()))
(handler-bind ((silly-condition #'handle-silly-condition)
(very-silly-condition #'handle-very-silly-condition)
(most-silly-condition #'handle-most-silly-condition))
(signal (make-condition 'very-silly-condition)))
(assert-equal '(:very-silly-condition :silly-condition) *list*)))
(define-test handler-transfer-of-control
;; A handler may decline to handle the condition if it returns normally,
;; or it may handle the condition by transferring control elsewhere.
(let ((*list* '()))
(block my-block
(handler-bind ((silly-condition #'handle-silly-condition)
(silly-condition (lambda (condition)
(declare (ignore condition))
(return-from my-block)))
(silly-condition #'handle-silly-condition))
(signal (make-condition 'silly-condition))))
(assert-equal '(:silly-condition) *list*)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun handle-error (condition)
(declare (ignore condition))
(push :error *list*))
(define-condition my-error (error) ())
(defun handle-my-error (condition)
(declare (ignore condition))
(push :my-error *list*))
(define-test handler-case
;; HANDLER-CASE always transfers control before executing the case forms.
(let ((*list* '()))
(handler-case (signal (make-condition 'my-error))
(error (condition) (handle-error condition))
(my-error (condition) (handle-my-error condition)))
(assert-equal '(:error) *list*)))
(define-test handler-case-order
;; The order of handler cases matters.
(let ((*list* '()))
(handler-case (signal (make-condition 'my-error))
(my-error (condition) (handle-my-error condition))
(error (condition) (handle-error condition)))
(assert-equal '(:my-error) *list*)))
(define-test handler-case-type
;; A handler 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 '(:error) *list*)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun divide (numerator denominator)
(/ numerator denominator))
(define-test error-signaling
;; ASSERT-ERROR is a Lisp Koans macro which verifies that the correct error
;; type is signaled.
(assert-equal 3 (divide 6 2))
(assert-error (divide 6 0) 'division-by-zero)
(assert-error (divide 6 :zero) 'type-error))
(define-test error-signaling-handler-case
(flet ((try-to-divide (numerator denominator)
;; In code outside Lisp Koans, HANDLER-CASE should be used.
(handler-case (divide numerator denominator)
(division-by-zero () :division-by-zero)
(type-error () :type-error))))
(assert-equal 3 (try-to-divide 6 2))
(assert-equal :division-by-zero (try-to-divide 6 0))
(assert-equal :type-error (try-to-divide 6 :zero))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Condition objects can contain metadata about the specific situation that
;;; occurred in the code.
(define-test accessors-division-by-zero
(let ((condition (handler-case (divide 6 0) (division-by-zero (c) c))))
;; Disabled on CLISP and ABCL due to conformance bugs.
;; See https://gitlab.com/gnu-clisp/clisp/-/issues/22
;; See https://github.com/armedbear/abcl/issues/177
#-(or clisp abcl)
(assert-equal '(6 0) (arithmetic-error-operands condition))
(let ((operation (arithmetic-error-operation condition)))
;; Disabled on ABCL due to a conformance bug.
;; See https://github.com/armedbear/abcl/issues/177
#-abcl
(assert-equal 3 (funcall operation 12 4)))))
(define-test accessors-type-error
(let ((condition (handler-case (divide 6 :zero) (type-error (c) c))))
(assert-equal :zero (type-error-datum condition))
(let ((expected-type (type-error-expected-type condition)))
(true-or-false? nil (typep :zero expected-type))
(true-or-false? t (typep 0 expected-type))
(true-or-false? nil (typep "zero" expected-type))
(true-or-false? t (typep 0.0 expected-type)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; We can define slots in our own condition types in a way that is similar to
;; DEFCLASS.
(define-condition parse-log-line-error (parse-error)
((line :initarg :line :reader line)
(reason :initarg :reason :reader reason)))
(defun log-line-type (line)
;; The macro CHECK-TYPE signals a TYPE-ERROR if the object is not of the
;; specified type.
(check-type line string)
(cond ((eql 0 (search "TIMESTAMP" line)) :timestamp)
((eql 0 (search "HTTP" line)) :http)
((eql 0 (search "LOGIN" line)) :login)
;; The function ERROR should be used for signaling serious conditions
;; and errors: if the condition is not handled, it halts program
;; execution and starts the Lisp debugger.
(t (error 'parse-log-line-error :line line
:reason :unknown-log-line-type))))
(define-test log-line-type-errors
(flet ((try-log-line-type (line)
(handler-case (log-line-type line)
(error (condition) condition))))
(assert-equal :timestamp (try-log-line-type "TIMESTAMP 2020-05-08 16:59:39"))
(assert-equal :http (try-log-line-type "HTTP GET / from 127.0.0.1"))
(assert-equal :login (try-log-line-type "LOGIN administrator:hunter2"))
(let ((condition (try-log-line-type "WARNING: 95% of disk space used")))
(assert-equal "WARNING: 95% of disk space used" (line condition))
(assert-equal :unknown-log-line-type (reason condition)))
(let ((condition (try-log-line-type 5555)))
(assert-equal 'string (type-error-expected-type condition))
(assert-equal 5555 (type-error-datum condition)))))

68
lisp-koans/koans-solved/control-statements.lisp Normal file
View File

@@ -0,0 +1,68 @@
;;; Copyright 2013 Google Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
(define-test if
;; IF only evaluates and returns one branch of a conditional expression.
(assert-equal :true (if t :true :false))
(assert-equal :false (if nil :true :false))
;; This also applies to side effects that migh or might not be evaluated.
(let ((result))
(if t
(setf result :true)
(setf result :false))
(assert-equal :true result)
(if nil
(setf result :true)
(setf result :false))
(assert-equal :false result)))
(define-test when-unless
;; WHEN and UNLESS are like one-branched IF statements.
(let ((when-result nil)
(when-numbers '())
(unless-result nil)
(unless-numbers '()))
(dolist (x '(1 2 3 4 5 6 7 8 9 10))
(when (> x 5)
(setf when-result x)
(push x when-numbers))
(unless (> x 5)
(setf unless-result x)
(push x unless-numbers)))
(assert-equal 10 when-result)
(assert-equal '(10 9 8 7 6) when-numbers)
(assert-equal 5 unless-result)
(assert-equal '(5 4 3 2 1) unless-numbers)))
(define-test and-short-circuit
;; AND only evaluates forms until one evaluates to NIL.
(assert-equal 5
(let ((x 0))
(and
(setf x (+ 2 x))
(setf x (+ 3 x))
nil
(setf x (+ 4 x)))
x)))
(define-test or-short-circuit
;; OR only evaluates forms until one evaluates to non-NIL.
(assert-equal 2
(let ((x 0))
(or
(setf x (+ 2 x))
(setf x (+ 3 x))
nil
(setf x (+ 4 x)))
x)))

95
lisp-koans/koans-solved/dice-project.lisp Normal file
View File

@@ -0,0 +1,95 @@
;;; Copyright 2013 Google Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; In this project, we are going to define a CLOS class representing a simple
;;; set of dice. There are only two operations on the dice: reading the dice
;;; values and re-rolling their values.
(defclass dice-set ()
;; Fill in the blank with a proper slot definition.
((values :accessor dice-values :initform '())))
;;; This method might be unnecessary, depending on how you define the slots of
;;; DICE-SET.
;; (defmethod dice-values ((object dice-set))
;; ____)
(defmethod roll (count (object dice-set))
(check-type count (integer 1))
(setf (dice-values object)
(loop repeat count collect (1+ (random 6)))))
(define-test make-dice-set
(let ((dice (make-instance 'dice-set)))
(assert-true (typep dice 'dice-set))))
(define-test dice-are-six-sided
(let ((dice (make-instance 'dice-set)))
(roll 5 dice)
(assert-true (typep (dice-values dice) 'list))
(assert-equal 5 (length (dice-values dice)))
(dolist (die (dice-values dice))
(assert-true (typep die '(integer 1 6))))))
(define-test dice-values-do-not-change-without-rolling
(let ((dice (make-instance 'dice-set)))
(roll 100 dice)
(let ((dice-values-1 (dice-values dice))
(dice-values-2 (dice-values dice)))
(assert-equal dice-values-1 dice-values-2))))
(define-test roll-returns-new-dice-values
(let* ((dice (make-instance 'dice-set))
(dice-values (roll 100 dice)))
(assert-true (equal dice-values (dice-values dice)))))
(define-test dice-values-should-change-between-rolling
(let* ((dice (make-instance 'dice-set))
(first-time (roll 100 dice))
(second-time (roll 100 dice)))
(assert-false (equal first-time second-time))
(assert-true (equal second-time (dice-values dice)))))
(define-test different-dice-sets-have-different-values
(let* ((dice-1 (make-instance 'dice-set))
(dice-2 (make-instance 'dice-set)))
(roll 100 dice-1)
(roll 100 dice-2)
(assert-false (equal (dice-values dice-1) (dice-values dice-2)))))
(define-test different-numbers-of-dice
(let ((dice (make-instance 'dice-set)))
(assert-equal 5 (length (roll 5 dice)))
(assert-equal 100 (length (roll 100 dice)))
(assert-equal 1 (length (roll 1 dice)))))
(define-test junk-as-dice-count
(let ((dice (make-instance 'dice-set)))
(labels ((dice-failure (count)
(handler-case (progn (roll count dice)
(error "Test failure"))
(error (condition) condition)))
(test-dice-failure (value)
(let* ((condition (dice-failure value))
(expected-type (type-error-expected-type condition)))
(assert-true (typep condition 'type-error))
(assert-equal value (type-error-datum condition))
(assert-true (subtypep '(integer 1 6) expected-type)))))
(test-dice-failure 0)
(test-dice-failure "0")
(test-dice-failure :zero)
(test-dice-failure 18.0)
(test-dice-failure -7)
(test-dice-failure '(6 6 6)))))

121
lisp-koans/koans-solved/equality-distinctions.lisp Normal file
View File

@@ -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)))

66
lisp-koans/koans-solved/evaluation.lisp Normal file
View File

@@ -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))))

27
lisp-koans/koans-solved/extra-credit.lisp Normal file
View File

@@ -0,0 +1,27 @@
;;; Copyright 2013 Google Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; EXTRA CREDIT:
;;;
;;; Create a program that will play the Greed game.
;;; The full rules for the game are in the file extra-credit.txt.
;;;
;;; You already have a DICE-SET class and a score function you can use.
;;; Write a PLAYER class and a GAME class to complete the project.
;;;
;;; This is a free form assignment, so approach it however you desire.
(define-test play-greed
;; This page intentionally left blank.
(assert-true t))

66
lisp-koans/koans-solved/extra-credit.txt Normal file
View File

@@ -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.

109
lisp-koans/koans-solved/format.lisp Normal file
View File

@@ -0,0 +1,109 @@
;;; Copyright 2013 Google Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; The function FORMAT is used to create formatted output. It is similar to
;;; the C function printf().
;;; See http://www.gigamonkeys.com/book/a-few-format-recipes.html
;;; T as the first argument to FORMAT prints the string to standard output.
;;; NIL as the first argument to FORMAT causes it to return the string.
(define-test format-basic
;; If there are no format directives in the string, FORMAT will return
;; a string that is STRING= to its format control.
(assert-equal "Lorem ipsum dolor sit amet"
(format nil "Lorem ipsum dolor sit amet")))
(define-test format-aesthetic
;; The ~A format directive creates aesthetic output.
(assert-equal "This is the number 42"
(format nil "This is the number ~A" 42))
(assert-equal "This is the keyword FOO"
(format nil "This is the keyword ~A" :foo))
(assert-equal "(/ 24 (- 3 (/ 8 3))) evaluates to 72"
(format nil "~A evaluates to ~A"
'(/ 24 (- 3 (/ 8 3)))
(/ 24 (- 3 (/ 8 3)))))
(assert-equal "This is the character C"
(format nil "This is the character ~A" #\C))
(assert-equal "In a galaxy far far away"
(format nil "In a ~A" "galaxy far far away")))
(define-test format-standard
;; The ~S format directive prints objects with escape characters.
;; Not all Lisp objects require to be escaped.
(assert-equal "This is the number 42" (format nil "This is the number ~S" 42))
(assert-equal "(/ 24 (- 3 (/ 8 3))) evaluates to 72"
(format nil "~S evaluates to ~S"
'(/ 24 (- 3 (/ 8 3)))
(/ 24 (- 3 (/ 8 3)))))
;; Keywords are printed with their leading colon.
(assert-equal "This is the keyword :FOO"
(format nil "This is the keyword ~S" :foo))
;; Characters are printed in their #\X form. The backslash will need to be
;; escaped inside the printed string, just like in "#\\X".
(assert-equal "This is the character #\\C"
(format nil "This is the character ~S" #\C))
;; Strings include quote characters, which must be escaped:
;; such a string might look in code like "foo \"bar\"".
(assert-equal "In a \"galaxy far far away\""
(format nil "In a ~S" "galaxy far far away")))
(define-test format-radix
;; The ~B, ~O, ~D, and ~X radices print numbers in binary, octal, decimal, and
;; hexadecimal notation.
(assert-equal "This is the number 101010"
(format nil "This is the number ~B" 42))
(assert-equal "This is the number 52"
(format nil "This is the number ~O" 42))
(assert-equal "This is the number 42"
(format nil "This is the number ~D" 42))
(assert-equal "This is the number 2A"
(format nil "This is the number ~X" 42))
;; We can specify a custom radix by using the ~R directive.
(assert-equal "This is the number 1120"
(format nil "This is the number ~3R" 42))
;; It is possible to print whole forms this way.
(let ((form '(/ 24 (- 3 (/ 8 3))))
(result (/ 24 (- 3 (/ 8 3)))))
(assert-equal "(/ 11000 (- 11 (/ 1000 11))) evaluates to 1001000"
(format nil "~B evaluates to ~B" form result))
(assert-equal "(/ 30 (- 3 (/ 10 3))) evaluates to 110"
(format nil "~O evaluates to ~O" form result))
(assert-equal "(/ 24 (- 3 (/ 8 3))) evaluates to 72"
(format nil "~D evaluates to ~D" form result))
(assert-equal "(/ 18 (- 3 (/ 8 3))) evaluates to 48"
(format nil "~X evaluates to ~X" form result))
(assert-equal "(/ 220 (- 10 (/ 22 10))) evaluates to 2200"
(format nil "~3R evaluates to ~3R" form result))))
(define-test format-iteration
;; The ~{ and ~} directives iterate over a list.
(assert-equal "[1][2][3][4][5][6]" (format nil "~{[~A]~}" '(1 2 3 4 5 6)))
(assert-equal "[1 2][3 4][5 6]" (format nil "~{[~A ~A]~}" '(1 2 3 4 5 6)))
;; The directive ~^ aborts iteration when no more elements remain.
(assert-equal "[1], [2], [3], [4], [5], [6]"
(format nil "~{[~A]~^, ~}" '(1 2 3 4 5 6))))
(define-test format-case
;; The ~( and ~) directives adjust the string case.
(assert-equal "the quick brown fox"
(format nil "~(~A~)" "The QuIcK BROWN fox"))
;; Some FORMAT directives can be further adjusted with the : and @ modifiers.
(assert-equal "The Quick Brown Fox"
(format nil "~:(~A~)" "The QuIcK BROWN fox"))
(assert-equal "The quick brown fox"
(format nil "~@(~A~)" "The QuIcK BROWN fox"))
(assert-equal "THE QUICK BROWN FOX"
(format nil "~:@(~A~)" "The QuIcK BROWN fox")))

184
lisp-koans/koans-solved/functions.lisp Normal file
View File

@@ -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)))

111
lisp-koans/koans-solved/hash-tables.lisp Normal file
View File

@@ -0,0 +1,111 @@
;;; Copyright 2013 Google Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; A hash table data structure is sometimes known as a dictionary.
(define-test make-hash-table
(let ((my-hash-table (make-hash-table)))
(true-or-false? t (typep my-hash-table 'hash-table))
(true-or-false? t (hash-table-p my-hash-table))
(true-or-false? nil (hash-table-p (make-array '(3 3 3))))
;; The function HASH-TABLE-COUNT returns the number of entries currently
;; contained in a hash table.
(assert-equal 0 (hash-table-count my-hash-table))))
(define-test gethash
;; The function GETHASH can be used to access hash table values.
(let ((cube-roots (make-hash-table)))
;; We add the key-value pair 1 - "uno" to the hash table.
(setf (gethash 1 cube-roots) "uno")
(assert-equal "uno" (gethash 1 cube-roots))
(assert-equal 1 (hash-table-count cube-roots))
(setf (gethash 8 cube-roots) 2)
(setf (gethash -3 cube-roots) -27)
(assert-equal -27 (gethash -3 cube-roots))
(assert-equal 3 (hash-table-count cube-roots))
;; GETHASH returns a secondary value that is true if the key was found in
;; the hash-table and false otherwise.
(multiple-value-bind (value foundp) (gethash 8 cube-roots)
(assert-equal 2 value)
(assert-equal t foundp))
(multiple-value-bind (value foundp) (gethash 125 cube-roots)
(assert-equal nil value)
(assert-equal nil foundp))))
(define-test hash-table-test
;; A hash table can be constructed with different test predicates.
;; The programmer may choose between EQ, EQL, EQUAL, and EQUALP to get the
;; best performance and expected results from the hash table.
;; The default test predicate is EQL.
(let ((eq-table (make-hash-table :test #'eq))
(eql-table (make-hash-table))
(equal-table (make-hash-table :test #'equal))
(equalp-table (make-hash-table :test #'equalp)))
;; We will define four variables whose values are strings.
(let* ((string "one")
(same-string string)
(string-copy (copy-seq string))
(string-upcased "ONE"))
;; We will insert the value of each variable into each hash table.
(dolist (thing (list string same-string string-copy string-upcased))
(dolist (hash-table (list eq-table eql-table equal-table equalp-table))
(setf (gethash thing hash-table) t))))
;; How many entries does each hash table contain?
(assert-equal 3 (hash-table-count eq-table))
(assert-equal 3 (hash-table-count eql-table))
(assert-equal 2 (hash-table-count equal-table))
(assert-equal 1 (hash-table-count equalp-table))))
(define-test hash-table-equality
;; EQUALP considers two hash tables to be equal if they have the same test and
;; if 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
;; Disabled on ECL due to a conformance bug.
;; See https://gitlab.com/embeddable-common-lisp/ecl/-/issues/587
#-ecl
(let ((hash-table-1 (make-hash-table :test #'equal))
(hash-table-2 (make-hash-table :test #'equal)))
(setf (gethash "one" hash-table-1) "uno"
(gethash "two" hash-table-1) "dos")
(setf (gethash "one" hash-table-2) "eins"
(gethash "two" hash-table-2) "zwei")
(assert-false (equalp hash-table-1 hash-table-2))
;; Change the first hash table to be EQUALP to the second one.
(setf (gethash "one" hash-table-1) "eins"
(gethash "two" hash-table-1) "zwei")
(assert-true (equalp hash-table-1 hash-table-2))))
(define-test make-your-own-hash-table
;; Make your own hash table that satisfies the test.
(let ((colors (make-hash-table :test #'equal)))
;; You will need to modify your hash table after you create it.
(setf (gethash "blue" colors) '(0 0 1)
(gethash "green" colors) '(0 1 0)
(gethash "red" colors) '(1 0 0)
(gethash "black" colors) '(0 0 0))
(assert-equal (hash-table-count colors) 4)
(let ((values (list (gethash "blue" colors)
(gethash "green" colors)
(gethash "red" colors))))
(assert-equal values '((0 0 1) (0 1 0) (1 0 0))))))

75
lisp-koans/koans-solved/iteration.lisp Normal file
View File

@@ -0,0 +1,75 @@
;;; Copyright 2013 Google Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; Lisp has multiple options for iteration.
;;; This set of koans will introduce some of the most common ones.
(define-test dolist
(let ((numbers '(4 8 15 16 23 42)))
;; The macro DOLIST binds a variable to subsequent elements of a list.
(let ((sum 0))
(dolist (number numbers)
;; (INCF PLACE N) is equivalent to (SETF PLACE (+ N PLACE)).
(incf sum number))
(assert-equal 108 sum))
;; DOLIST can optionally return a value.
(let ((sum 0))
(assert-equal 108 (dolist (number numbers sum)
(incf sum number))))))
(define-test dotimes
;; The macro DOTIMES binds a variable to subsequent integers from 0 to
;; (1- COUNT).
(let ((stack '()))
(dotimes (i 5)
(push i stack))
(assert-equal '(4 3 2 1 0) stack))
;; DOTIMES can optionally return a value.
(let ((stack '()))
(assert-equal '(4 3 2 1 0) (dotimes (i 5 stack)
(push i stack)))))
(define-test do
;; The macro DO accepts a list of variable bindings, a termination test with
;; epilogue forms, and Lisp code that should be executed on each iteration.
(let ((result '()))
(do ((i 0 (1+ i)))
((> i 5))
(push i result))
(assert-equal '(0 1 2 3 4 5) (nreverse result)))
;; The epilogue of DO can return a value.
(let ((result (do ((i 0 (1+ i))
;; A variable bound by DO noes not need to be updated on
;; each iteration.
(result '()))
((> i 5) (nreverse result))
(push i result))))
(assert-equal '(0 1 2 3 4 5) result)))
(define-test loop-basic-form
;; The macro LOOP in its simple form loops forever. It is possible to stop the
;; looping by calling the RETURN special form.
(let ((counter 0))
(loop (incf counter)
(when (>= counter 100)
(return counter)))
(assert-equal 100 counter))
;; The RETURN special form can return a value out of a LOOP.
(let ((counter 0))
(assert-equal 100 (loop (incf counter)
(when (>= counter 100)
(return counter)))))
;; The extended form of LOOP will be contemplated in a future koan.
)

62
lisp-koans/koans-solved/let.lisp Normal file
View File

@@ -0,0 +1,62 @@
;;; Copyright 2013 Google Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
(define-test let
;; The LET form establishes a lexical extent within which new variables are
;; created: a symbol that names a variable becomes bound to a value.
(let ((x 10)
(y 20))
(assert-equal 30 (+ x y))
;; It is possible to shadow previously visible bindings.
(let ((y 30))
(assert-equal 40 (+ x y)))
(assert-equal 30 (+ x y)))
;; Variables bound by LET have a default value of NIL.
(let (x)
(assert-equal nil x)))
(define-test let-versus-let*
;; LET* is similar to LET, except the bindings are established sequentially,
;; and a binding may use bindings that were established before it.
(let ((x 10)
(y 20))
(let ((x (+ y 100))
(y (+ x 100)))
(assert-equal 120 x)
(assert-equal 110 y))
(let* ((x (+ y 100))
(y (+ x 100)))
;; Which X is used to compute the value of Y?
(assert-equal 120 x)
(assert-equal 220 y))))
(define-test let-it-be-equal
;; Fill in the LET and LET* to get the tests to pass.
(let ((a 1)
(b :two)
(c "Three"))
(let ((a 100)
(b 200)
(c "Jellyfish"))
(assert-equal a 100)
(assert-equal b 200)
(assert-equal c "Jellyfish"))
(let* ((a 121)
(b 200)
;; In this third binding, you are allowed to use the variables bound
;; by the previous two LET* bindings.
(c (+ a (/ b a))))
(assert-equal a 121)
(assert-equal b 200)
(assert-equal c (+ a (/ b a))))))

146
lisp-koans/koans-solved/lists.lisp Normal file
View File

@@ -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))))

140
lisp-koans/koans-solved/loops.lisp Normal file
View File

@@ -0,0 +1,140 @@
;;; Copyright 2013 Google Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; The extended for of LOOP allows for advanced iteration.
;;; See http://www.gigamonkeys.com/book/loop-for-black-belts.html
(define-test loop-collect
;; LOOP can collect the results in various ways.
(let* ((result-1 (loop for letter in '(#\a #\b #\c #\d) collect letter))
(result-2 (loop for number in '(1 2 3 4 5) sum number))
(result-3 (loop for list in '((foo) (bar) (baz)) append list)))
(assert-equal '(#\a #\b #\c #\d) result-1)
(assert-equal 15 result-2)
(assert-equal '(foo bar baz) result-3)))
(define-test loop-multiple-variables
;; With multiple FOR clauses, the loop ends when any of the provided lists are
;; exhausted.
(let* ((letters '(:a :b :c :d))
(result (loop for letter in letters
for i from 1 to 1000
collect (list i letter))))
(assert-equal '((1 :a) (2 :b) (3 :c) (4 :d)) result)))
(define-test loop-in-versus-loop-on
;; Instead of iterating over each element of a list, we can iterate over each
;; cons cell of a list.
(let* ((letters '(:a :b :c))
(result-in (loop for thing in letters collect thing))
(result-on (loop for thing on letters collect thing)))
(assert-equal '(:a :b :c) result-in)
(assert-equal '((:a :b :c) (:b :c) (:c)) result-on)))
(define-test loop-for-by
;; Numeric iteration can go faster or slower if we use the BY keyword.
(let* ((result (loop for i from 0 to 30 by 5 collect i)))
(assert-equal '(0 5 10 15 20 25 30) result)))
(define-test loop-counting-backwards
;; We can count downwards instead of upwards by using DOWNTO instead of TO.
(let ((result (loop for i from 5 downto -5 collect i)))
(assert-equal '(5 4 3 2 1 0 -1 -2 -3 -4 -5) result)))
(define-test loop-list-by
;; List iteration can go faster or slower if we use the BY keyword.
(let* ((letters '(:a :b :c :d :e :f))
(result (loop for letter in letters collect letter))
(result-cdr (loop for letter in letters by #'cdr collect letter))
(result-cddr (loop for letter in letters by #'cddr collect letter))
(result-cdddr (loop for letter in letters by #'cdddr collect letter)))
(assert-equal '(:a :b :c :d :e :f) result)
(assert-equal '(:a :b :c :d :e :f) result-cdr)
(assert-equal '(:a :c :e) result-cddr)
(assert-equal '(:a :d) result-cdddr)))
(define-test loop-across
;; LOOP can iterate over a vector with the ACROSS keyword.
(let* ((vector (make-array '(5) :initial-contents '(0 1 2 3 4)))
(result (loop for number across vector collect number)))
(assert-equal '(0 1 2 3 4) result)))
(define-test loop-over-2d-array
(let ((array (make-array '(3 2) :initial-contents '((0 1) (2 3) (4 5)))))
;; LOOP can be combined with ROW-MAJOR-AREF to iterate over the contents of
;; a multidimensional array.
(let* ((result (loop for i from 0 below (array-total-size array)
collect (row-major-aref array i))))
(assert-equal '(0 1 2 3 4 5) result))
;; It is always possible to resort to nested loops.
(let* ((result (loop with max-i = (array-dimension array 0)
for i from 0 below max-i
collect (loop with max-j = (array-dimension array 1)
for j from 0 below max-j
collect (expt (aref array i j) 2)))))
(assert-equal '((0 1) (4 9) (16 25)) result))))
(define-test loop-hash-table
(let ((book-heroes (make-hash-table :test 'equal)))
(setf (gethash "The Hobbit" book-heroes) "Bilbo"
(gethash "Where The Wild Things Are" book-heroes) "Max"
(gethash "The Wizard Of Oz" book-heroes) "Dorothy"
(gethash "The Great Gatsby" book-heroes) "James Gatz")
;; LOOP can iterate over hash tables.
(let ((pairs-in-table (loop for key being the hash-keys of book-heroes
using (hash-value value)
collect (list key value))))
(assert-equal 4 (length pairs-in-table))
(true-or-false? t (find '("The Hobbit" "Bilbo") pairs-in-table
:test #'equal)))))
(define-test loop-statistics
;; LOOP can perform basics statistics on the collected elements.
(let ((result (loop for x in '(1 2 4 8 16 32)
collect x into collected
count x into counted
sum x into summed
maximize x into maximized
minimize x into minimized
finally (return (list collected counted summed
maximized minimized)))))
(destructuring-bind (collected counted summed maximized minimized) result
(assert-equal '(1 2 4 8 16 32) collected)
(assert-equal 6 counted)
(assert-equal 63 summed)
(assert-equal 32 maximized)
(assert-equal 1 minimized))))
(define-test loop-destructuring
;; LOOP can bind multiple variables on each iteration step.
(let* ((count 0)
(result (loop for (a b) in '((1 9) (2 8) (3 7) (4 6))
do (incf count)
collect (+ a b))))
(assert-equal 4 count)
(assert-equal '(10 10 10 10) result)))
(define-test loop-conditional-execution
(let ((numbers '(1 1 2 3 5 8 13 21)))
;; LOOP can execute some actions conditionally.
(let ((result (loop for x in numbers
when (evenp x) sum x)))
(assert-equal 10 result))
(let ((result (loop for x in numbers
unless (evenp x) sum x)))
(assert-equal 44 result))
(flet ((greater-than-10-p (x) (> x 10)))
(let ((result (loop for x in numbers
when (greater-than-10-p x) sum x)))
(assert-equal 34 result)))))

123
lisp-koans/koans-solved/macros.lisp Normal file
View File

@@ -0,0 +1,123 @@
;;; Copyright 2013 Google Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; A Lisp macro is a function that accepts Lisp data and produces a Lisp form.
;;; When the macro is called, its macro function receives unevaluated arguments
;;; and may use them to produce a new Lisp form. This form is then spliced in
;;; place of the original macro call and is then evaluated.
(defmacro my-and (&rest forms)
;; We use a LABELS local function to allow for recursive expansion.
(labels ((generate (forms)
(cond ((null forms) 'nil)
((null (rest forms)) (first forms))
(t `(when ,(first forms)
,(generate (rest forms)))))))
(generate forms)))
(define-test my-and
;; ASSERT-EXPANDS macroexpands the first form once and checks if it is equal
;; to the second form.
(assert-expands (my-and (= 0 (random 6)) (error "Bang!"))
'(when (= 0 (random 6)) (error "Bang!")))
(assert-expands (my-and (= 0 (random 6))
(= 0 (random 6))
(= 0 (random 6))
(error "Bang!"))
'(when (= 0 (random 6))
(when (= 0 (random 6))
(when (= 0 (random 6))
(error "Bang!"))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; A common macro pitfall is capturing a variable defined by the user.
(define-test variable-capture
(macrolet ((for ((var start stop) &body body)
`(do ((,var ,start (1+ ,var))
(limit ,stop))
((> ,var limit))
,@body)))
(let ((limit 10)
(result '()))
(for (i 0 3)
(push i result)
(assert-equal 3 limit))
(assert-equal '(0 1 2 3) (nreverse result)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Another pitfall is evaluating some forms multiple times where they are only
;;; meant to be evaluated once.
(define-test multiple-evaluation
;; We use MACROLET for defining a local macro.
(macrolet ((for ((var start stop) &body body)
`(do ((,var ,start (1+ ,var)))
((> ,var ,stop))
,@body)))
(let ((side-effects '())
(result '()))
;; Our functions RETURN-0 and RETURN-3 have side effects.
(flet ((return-0 () (push 0 side-effects) 0)
(return-3 () (push 3 side-effects) 3))
(for (i (return-0) (return-3))
(push i result)))
(assert-equal '(0 1 2 3) (nreverse result))
(assert-equal '(0 3 3 3 3 3) (nreverse side-effects)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Yet another pitfall is not respecting the evaluation order of the macro
;;; subforms.
(define-test wrong-evaluation-order
(macrolet ((for ((var start stop) &body body)
;; The function GENSYM creates GENerated SYMbols, guaranteed to
;; be unique in the whole Lisp system. Because of that, they
;; cannot capture other symbols, preventing variable capture.
(let ((limit (gensym "LIMIT")))
`(do ((,limit ,stop)
(,var ,start (1+ ,var)))
((> ,var ,limit))
,@body))))
(let ((side-effects '())
(result '()))
(flet ((return-0 () (push 0 side-effects) 0)
(return-3 () (push 3 side-effects) 3))
(for (i (return-0) (return-3))
(push i result)))
(assert-equal '(0 1 2 3) (nreverse result))
(assert-equal '(3 0) (nreverse side-effects)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-test for
(macrolet ((for ((var start stop) &body body)
;; Fill in the blank with a correct FOR macroexpansion that is
;; not affected by the three macro pitfalls mentioned above.
(let ((limit (gensym "LIMIT")))
`(do ((,var ,start (1+ ,var))
(,limit ,stop))
((> ,var ,limit))
,@body))))
(let ((side-effects '())
(result '()))
(flet ((return-0 () (push 0 side-effects) 0)
(return-3 () (push 3 side-effects) 3))
(for (i (return-0) (return-3))
(push i result)))
(assert-equal '(0 1 2 3) (nreverse result))
(assert-equal '(0 3) (nreverse side-effects)))))

102
lisp-koans/koans-solved/mapcar-and-reduce.lisp Normal file
View File

@@ -0,0 +1,102 @@
;;; Copyright 2013 Google Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; Lisp supports several functional alternatives to imperative iteration.
(define-test mapcar
(let ((numbers '(1 2 3 4 5 6)))
;; Inside MAPCAR, 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 '(-1 -2 -3 -4 -5 -6) (mapcar #'- numbers))
(assert-equal '((1) (2) (3) (4) (5) (6)) (mapcar #'list numbers))
(assert-equal '(nil t nil t nil t) (mapcar #'evenp numbers))
(assert-equal '(t t t t t t) (mapcar #'numberp numbers))
(assert-equal '(nil nil nil nil nil nil) (mapcar #'stringp numbers))
;; MAPCAR can work on multiple lists. The function will receive one argument
;; from each list.
(let ((other-numbers '(4 8 15 16 23 42)))
(assert-equal '(5 10 18 20 28 48) (mapcar #'+ numbers other-numbers))
(assert-equal '(4 16 45 64 115 252) (mapcar #'* numbers other-numbers))
;; The function MOD performs modulo division.
(assert-equal '(0 0 0 0 3 0) (mapcar #'mod other-numbers numbers)))))
(define-test mapcar-lambda
;; MAPCAR is often used with anonymous functions.
(let ((numbers '(8 21 152 37 403 14 7 -34)))
(assert-equal '(8 1 2 7 3 4 7 6) (mapcar (lambda (x) (mod x 10)) numbers)))
(let ((strings '("Mary had a little lamb"
"Old McDonald had a farm"
"Happy birthday to you")))
(assert-equal '(" had a l" "McDonald" "y birthd")
(mapcar (lambda (x) (subseq x 4 12)) strings))))
(define-test map
;; MAP is a variant of MAPCAR that works on any sequences.
;; It allows to specify the type of the resulting sequence.
(let ((string "lorem ipsum"))
(assert-equal "LOREM IPSUM" (map 'string #'char-upcase string))
(assert-equal '(#\L #\O #\R #\E #\M #\Space #\I #\P #\S #\U #\M)
(map 'list #'char-upcase string))
;; Not all vectors containing characters are strings.
(assert-equalp #(#\L #\O #\R #\E #\M #\Space #\I #\P #\S #\U #\M)
(map '(vector t) #'char-upcase string))))
(define-test transposition
;; MAPCAR gives the function as many arguments as there are lists.
(flet ((transpose (lists) (apply #'mapcar #'list lists)))
(let ((list '((1 2 3)
(4 5 6)
(7 8 9)))
(transposed-list '((1 4 7)
(2 5 8)
(3 6 9))))
(assert-equal transposed-list (transpose list))
(assert-equal list (transpose (transpose list))))
(assert-equal '(("these" "pretzels" "are")
("making" "me" "thirsty"))
(transpose '(("these" "making")
("pretzels" "me")
("are" "thirsty"))))))
(define-test reduce
;; The function REDUCE combines the elements of a list by applying a binary
;; function to the elements of a sequence from left to right.
(assert-equal 15 (reduce #'+ '(1 2 3 4 5)))
(assert-equal 10 (reduce #'+ '(1 2 3 4)))
(assert-equal 1 (reduce #'expt '(1 2 3 4 5))))
(define-test reduce-from-end
;; The :FROM-END keyword argument can be used to reduce from right to left.
(let ((numbers '(1 2 3 4 5)))
(assert-equal '((((1 . 2) . 3) . 4) . 5) (reduce #'cons numbers))
(assert-equal '(1 2 3 4 . 5) (reduce #'cons numbers :from-end t)))
(let ((numbers '(2 3 2)))
(assert-equal 64 (reduce #'expt numbers))
(assert-equal 512 (reduce #'expt numbers :from-end t))))
(define-test reduce-initial-value
;; :INITIAL-VALUE can supply the initial value for the reduction.
(let ((numbers '(1 2 3 4 5)))
(assert-equal 120 (reduce #'* numbers))
(assert-equal 0 (reduce #'* numbers :initial-value 0))
(assert-equal -120 (reduce #'* numbers :initial-value -1))))
(define-test inner-product
;; MAPCAR and REDUCE are powerful when used together.
;; Fill in the blanks to produce a local function that computes an inner
;; product of two vectors.
(flet ((inner-product (x y) (reduce #'+ (mapcar #'* x y))))
(assert-equal 32 (inner-product '(1 2 3) '(4 5 6)))
(assert-equal 310 (inner-product '(10 20 30) '(4 3 7)))))

41
lisp-koans/koans-solved/multiple-values.lisp Normal file
View File

@@ -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))))

52
lisp-koans/koans-solved/nil-false-empty.lisp Normal file
View File

@@ -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)))

48
lisp-koans/koans-solved/scope-and-extent.lisp Normal file
View File

@@ -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)))))

97
lisp-koans/koans-solved/scoring-project.lisp Normal file
View File

@@ -0,0 +1,97 @@
;;; Copyright 2013 Google Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; Greed is a dice game played among 2 or more players, using 5
;;; six-sided dice.
;;;
;;; Each player takes a turn consisting of one or more rolls of the dice.
;;; On the first roll of the game, a player rolls all five dice which are
;;; scored according to the following:
;;;
;;; Three 1's => 1000 points
;;; Three 6's => 600 points
;;; Three 5's => 500 points
;;; Three 4's => 400 points
;;; Three 3's => 300 points
;;; Three 2's => 200 points
;;; One 1 => 100 points
;;; One 5 => 50 points
;;;
;;; A single die can only be counted once in each roll. For example,
;;; a "5" can only count as part of a triplet (contributing to the 500
;;; points) or as a single 50 points, but not both in the same roll.
;;;
;;; Example Scoring
;;;
;;; Throw Score
;;; --------- ------------------
;;; 5 1 3 4 1 50 + 2 * 100 = 250
;;; 1 1 1 3 1 1000 + 100 = 1100
;;; 2 4 4 5 4 400 + 50 = 450
;;;
;;; The dice not contributing to the score are called the non-scoring
;;; dice. "3" and "4" are non-scoring dice in the first example. "3" is
;;; a non-scoring die in the second, and "2" is a non-score die in the
;;; final example.
;;;
;;; More scoring examples are given in the tests below.
;;;
;;; Your goal is to write the scoring function for Greed.
(defun score-once (&rest dice)
(let ((sorted (sort (copy-list dice) #'<)))
(cond ((search '(1 1 1) sorted) (list 1000 (remove 1 sorted :count 3)))
((search '(2 2 2) sorted) (list 200 (remove 2 sorted :count 3)))
((search '(3 3 3) sorted) (list 300 (remove 3 sorted :count 3)))
((search '(4 4 4) sorted) (list 400 (remove 4 sorted :count 3)))
((search '(5 5 5) sorted) (list 500 (remove 5 sorted :count 3)))
((search '(6 6 6) sorted) (list 600 (remove 6 sorted :count 3)))
((find 5 sorted) (list 50 (remove 5 sorted :count 1)))
((find 1 sorted) (list 100 (remove 1 sorted :count 1)))
(t (list 0 '())))))
(defun score (&rest dice)
(loop for current-dice = dice then remaining-dice
for (score remaining-dice) = (apply #'score-once current-dice)
sum score
while remaining-dice))
(define-test score-of-an-empty-list-is-zero
(assert-equal 0 (score)))
(define-test score-of-a-single-roll-of-5-is-50
(assert-equal 50 (score 5)))
(define-test score-of-a-single-roll-of-1-is-100
(assert-equal 100 (score 1)))
(define-test score-of-multiple-1s-and-5s-is-the-sum-of-individual-scores
(assert-equal 300 (score 1 5 5 1)))
(define-test score-of-single-2s-3s-4s-and-6s-are-zero
(assert-equal 0 (score 2 3 4 6)))
(define-test score-of-a-triple-1-is-1000
(assert-equal 1000 (score 1 1 1)))
(define-test score-of-other-triples-is-100x
(assert-equal 200 (score 2 2 2))
(assert-equal 300 (score 3 3 3))
(assert-equal 400 (score 4 4 4))
(assert-equal 500 (score 5 5 5))
(assert-equal 600 (score 6 6 6)))
(define-test score-of-mixed-is-sum
(assert-equal 250 (score 2 5 2 2 3))
(assert-equal 550 (score 5 5 5 5)))

220
lisp-koans/koans-solved/std-method-comb.lisp Normal file
View File

@@ -0,0 +1,220 @@
;;; Copyright 2013 Google Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
(defclass access-counter ()
((value :accessor value :initarg :value)
(access-count :reader access-count :initform 0)))
;;; The generated reader, writer, and accessor functions are generic functions.
;;; The methods of a generic function are combined using a method combination;
;;; by default, the standard method combination is used.
;;; This allows us to define :BEFORE and :AFTER methods whose code is executed
;;; before or after the primary method, and whose return values are discarded.
;;; The :BEFORE and :AFTER keywords used in this context are called qualifiers.
(defmethod value :after ((object access-counter))
(incf (slot-value object 'access-count)))
(defmethod (setf value) :after (new-value (object access-counter))
(incf (slot-value object 'access-count)))
(define-test defmethod-after
(let ((counter (make-instance 'access-counter :value 42)))
(assert-equal 0 (access-count counter))
(assert-equal 42 (value counter))
(assert-equal 1 (access-count counter))
(setf (value counter) 24)
(assert-equal 2 (access-count counter))
(assert-equal 24 (value counter))
(assert-equal 3 (access-count counter))
;; We read the value three more times and discard the result.
(value counter)
(value counter)
(value counter)
(assert-equal 6 (access-count counter))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; In addition to :BEFORE and :AFTER methods is also possible to write :AROUND
;;; methods, which execute instead of the primary methods. In such context, it
;;; is possible to call the primary method via CALL-NEXT-METHOD.
;;; In the standard method combination, the :AROUND method, if one exists, is
;;; executed first, and it may choose whether and how to call next methods.
(defgeneric grab-lollipop ()
(:method () :lollipop))
(defgeneric grab-lollipop-while-mom-is-nearby (was-nice-p)
(:method :around (was-nice-p) (if was-nice-p (call-next-method) :no-lollipop))
(:method (was-nice-p) (declare (ignore was-nice-p)) :lollipop))
(define-test lollipop
(assert-equal :lollipop (grab-lollipop))
(assert-equal :lollipop (grab-lollipop-while-mom-is-nearby t))
(assert-equal :no-lollipop (grab-lollipop-while-mom-is-nearby nil)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass countdown ()
;; The countdown object represents an ongoing countdown. Each time the
;; REMAINING-TIME function is called, it should return a number one less than
;; the previous time that it returned. If the countdown hits zero, :BANG
;; should be returned instead.
((remaining-time :reader remaining-time :initarg :time)))
(defmethod remaining-time :around ((object countdown))
(let ((time (call-next-method)))
(if (< 0 time)
;; DECF is similar to INCF. It decreases the value stored in the place
;; and returns the decreased value.
(decf (slot-value object 'remaining-time))
:bang)))
(define-test countdown
(let ((countdown (make-instance 'countdown :time 4)))
(assert-equal 3 (remaining-time countdown))
(assert-equal 2 (remaining-time countdown))
(assert-equal 1 (remaining-time countdown))
(assert-equal 0 (remaining-time countdown))
(assert-equal :bang (remaining-time countdown))
(assert-equal :bang (remaining-time countdown))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; It is possible for multiple :BEFORE, :AFTER, :AROUND, or primary methods to
;;; be executed in a single method call.
(defclass object ()
((counter :accessor counter :initform 0)))
(defclass bigger-object (object) ())
(defgeneric frobnicate (x)
(:method :around ((x bigger-object))
(incf (counter x) 8)
(call-next-method))
(:method :around ((x object))
(incf (counter x) 70)
(call-next-method))
(:method :before ((x bigger-object))
(incf (counter x) 600))
(:method :before ((x object))
(incf (counter x) 5000))
(:method ((x bigger-object))
(incf (counter x) 40000)
(call-next-method))
(:method ((x object))
(incf (counter x) 300000))
(:method :after ((x object))
(incf (counter x) 2000000))
(:method :after ((x bigger-object))
(incf (counter x) 10000000)))
(define-test multiple-methods
(let ((object (make-instance 'object)))
(frobnicate object)
(assert-equal 2305070 (counter object)))
(let ((object (make-instance 'bigger-object)))
(frobnicate object)
(assert-equal 12345678 (counter object))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The method order of the standard combination is as follows:
;;; First, the most specific :AROUND method is executed.
;;; Second, all :BEFORE methods are executed, most specific first.
;;; Third, the most specific primary method is executed.
;;; Fourth, all :AFTER methods are executed, most specific last.
(defgeneric calculate (x)
(:method :around ((x bigger-object))
(setf (counter x) 40)
(call-next-method))
(:method :around ((x object))
(incf (counter x) 24)
(call-next-method))
(:method :before ((x bigger-object))
(setf (counter x) (mod (counter x) 6)))
(:method :before ((x object))
(setf (counter x) (/ (counter x) 4)))
(:method ((x bigger-object))
(setf (counter x) (* (counter x) (counter x)))
(call-next-method))
(:method ((x object))
(decf (counter x) 100))
(:method :after ((x object))
(setf (counter x) (/ 1 (counter x))))
(:method :after ((x bigger-object))
(incf (counter x) 2)))
(define-test standard-method-combination-order
(let ((object (make-instance 'object)))
(calculate object)
(assert-equal -1/94 (counter object)))
(let ((object (make-instance 'bigger-object)))
(calculate object)
(assert-equal 197/99 (counter object))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defclass programmer () ())
(defclass senior-programmer (programmer) ())
(defclass full-stack-programmer (programmer) ())
(defclass senior-full-stack-programmer (senior-programmer
full-stack-programmer)
())
;;; The :BEFORE, :AFTER, and :AROUND methods are only available in the standard
;;; method combination. It is possible to use other method combinations, such as
;;; +.
(defgeneric salary-at-company-a (programmer)
(:method-combination +)
(:method + ((programmer programmer)) 120000)
(:method + ((programmer senior-programmer)) 200000)
(:method + ((programmer full-stack-programmer)) 48000))
(define-test salary-at-company-a
(let ((programmer (make-instance 'programmer)))
(assert-equal 120000 (salary-at-company-a programmer)))
(let ((programmer (make-instance 'senior-programmer)))
(assert-equal 320000 (salary-at-company-a programmer)))
(let ((programmer (make-instance 'full-stack-programmer)))
(assert-equal 168000 (salary-at-company-a programmer)))
(let ((programmer (make-instance 'senior-full-stack-programmer)))
(assert-equal 368000 (salary-at-company-a programmer))))
;;; It is also possible to define custom method combinations.
(define-method-combination multiply :operator *)
(defgeneric salary-at-company-b (programmer)
(:method-combination multiply)
(:method multiply ((programmer programmer)) 120000)
(:method multiply ((programmer senior-programmer)) 2)
(:method multiply ((programmer full-stack-programmer)) 7/5))
(define-test salary-at-company-b
(let ((programmer (make-instance 'programmer)))
(assert-equal 120000 (salary-at-company-b programmer)))
(let ((programmer (make-instance 'senior-programmer)))
(assert-equal 240000 (salary-at-company-b programmer)))
(let ((programmer (make-instance 'full-stack-programmer)))
(assert-equal 168000 (salary-at-company-b programmer)))
(let ((programmer (make-instance 'senior-full-stack-programmer)))
(assert-equal 336000 (salary-at-company-b programmer))))

73
lisp-koans/koans-solved/strings.lisp Normal file
View File

@@ -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))))

111
lisp-koans/koans-solved/structures.lisp Normal file
View File

@@ -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))))))

161
lisp-koans/koans-solved/threads.lisp Normal file
View File

@@ -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*)))

75
lisp-koans/koans-solved/triangle-project.lisp Normal file
View File

@@ -0,0 +1,75 @@
;;; Copyright 2013 Google Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
(define-condition triangle-error (error)
;; Fill in the blank with a suitable slot definition.
((triangle-error-sides :reader triangle-error-sides :initarg :sides)))
(defun triangle (a b c)
(check-type a (real (0)))
(check-type b (real (0)))
(check-type c (real (0)))
;; Fill in the blank with a function that satisfies the below tests.
(let* ((min (min a b c))
(max (max a b c))
(mid (car (remove min (remove max (list a b c) :count 1) :count 1))))
(cond ((<= (+ min mid) max) (error 'triangle-error :sides (list a b c)))
((= max mid min) :equilateral)
((= max mid) :isosceles)
((= mid min) :isosceles)
(t :scalene))))
(define-test equilateral-triangles
;; Equilateral triangles have three sides of equal length,
(assert-equal :equilateral (triangle 2 2 2))
(assert-equal :equilateral (triangle 10 10 10)))
(define-test isosceles-triangles
;; Isosceles triangles have two sides of equal length,
(assert-equal :isosceles (triangle 3 4 4))
(assert-equal :isosceles (triangle 4 3 4))
(assert-equal :isosceles (triangle 4 4 3))
(assert-equal :isosceles (triangle 2 2 3))
(assert-equal :isosceles (triangle 10 10 2)))
(define-test scalene-triangles
;; Scalene triangles have three sides of different lengths.
(assert-equal :scalene (triangle 3 4 5))
(assert-equal :scalene (triangle 10 11 12))
(assert-equal :scalene (triangle 5 4 2)))
(define-test illegal-triangles
;; Not all triplets make valid triangles.
(flet ((triangle-failure (a b c)
(handler-case (progn (triangle a b c) (error "Test failure"))
(error (condition) condition))))
(let ((condition (triangle-failure 0 0 0)))
(assert-true (typep condition 'type-error))
(assert-equal 0 (type-error-datum condition))
;; The type (REAL (0)) represents all positive numbers.
(assert-true (subtypep (type-error-expected-type condition) '(real (0))))
;; If two type specifiers are SUBTYPEP of one another, then they represent
;; the same Lisp type.
(assert-true (subtypep '(real (0)) (type-error-expected-type condition))))
(let ((condition (triangle-failure 3 4 -5)))
(assert-true (typep condition 'type-error))
(assert-equal -5 (type-error-datum condition))
(assert-true (subtypep (type-error-expected-type condition) '(real (0))))
(assert-true (subtypep '(real (0)) (type-error-expected-type condition))))
(let ((condition (triangle-failure 1 1 3)))
(assert-true (typep condition 'triangle-error))
(assert-equal '(1 1 3) (triangle-error-sides condition)))
(let ((condition (triangle-failure 2 4 2)))
(assert-true (typep condition 'triangle-error))
(assert-equal '(2 4 2) (triangle-error-sides condition)))))

153
lisp-koans/koans-solved/type-checking.lisp Normal file
View File

@@ -0,0 +1,153 @@
;;; Copyright 2013 Google Inc.
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; There is a type hierarchy in Lisp, based on the set theory.
;;; An object may belong to multiple types at the same time.
;;; Every object is of type T. No object is of type NIL.
(define-test typep
;; TYPEP returns true if the provided object is of the provided type.
(true-or-false? t (typep "hello" 'string))
(true-or-false? t (typep "hello" 'array))
(true-or-false? nil (typep "hello" 'list))
(true-or-false? t (typep "hello" '(simple-array character (5))))
(true-or-false? t (typep '(1 2 3) 'list))
(true-or-false? t (typep 99 'integer))
(true-or-false? t (typep nil 'NULL))
(true-or-false? t (typep 22/7 'ratio))
(true-or-false? t (typep 4.0 'float))
(true-or-false? t (typep #\a 'character))
(true-or-false? t (typep #'length 'function)))
(define-test type-of
;; TYPE-OF returns a type specifier for the object.
(assert-equal 'null (type-of '()))
(assert-equal 'ratio (type-of 4/6)))
(define-test overlapping-types
;; Because Lisp types are mathematical sets, they are allowed to overlap.
(let ((thing '()))
(true-or-false? t (typep thing 'list))
(true-or-false? t (typep thing 'atom))
(true-or-false? t (typep thing 'null))
(true-or-false? t (typep thing 't))))
(define-test fixnum-versus-bignum
;; In Lisp, integers are either fixnums or bignums. Fixnums are handled more
;; efficiently by the implementation, but some large integers can only be
;; represented as bignums.
;; Lisp converts between these two types on the fly. The constants
;; MOST-NEGATIVE-FIXNUM and MOST-POSITIVE-FIXNUM describe the limits for
;; fixnums.
(let ((integer-1 0)
(integer-2 most-positive-fixnum)
(integer-3 (1+ most-positive-fixnum))
(integer-4 (1- most-negative-fixnum)))
(true-or-false? t (typep integer-1 'fixnum))
(true-or-false? nil (typep integer-1 'bignum))
(true-or-false? t (typep integer-2 'fixnum))
(true-or-false? nil (typep integer-2 'bignum))
(true-or-false? nil (typep integer-3 'fixnum))
(true-or-false? t (typep integer-3 'bignum))
(true-or-false? nil (typep integer-4 'fixnum))
(true-or-false? t (typep integer-4 'bignum))
;; Regardless of whether an integer is a fixnum or a bignum, it is still
;; an integer.
(true-or-false? t (typep integer-1 'integer))
(true-or-false? t (typep integer-2 'integer))
(true-or-false? t (typep integer-3 'integer))
(true-or-false? t (typep integer-4 'integer))))
(define-test subtypep
(assert-true (typep 1 'bit))
(assert-true (typep 1 'fixnum))
(assert-true (typep 1 'integer))
(assert-true (typep 2 'integer))
;; The function SUBTYPEP attempts to answer whether one type specifier
;; represents a subtype of the other type specifier.
(true-or-false? t (subtypep 'bit 'integer))
(true-or-false? t (subtypep 'vector 'array))
(true-or-false? t (subtypep 'string 'vector))
(true-or-false? t (subtypep 'null 'list)))
(define-test list-type-specifiers
;; Some type specifiers are lists; this way, they carry more information than
;; type specifiers which are symbols.
(assert-true (typep (make-array 0) '(vector * 0)))
(assert-true (typep (make-array 42) '(vector * 42)))
(assert-true (typep (make-array 42 :element-type 'bit) '(vector bit 42)))
(assert-true (typep (make-array '(4 2)) '(array * (4 2))))
(true-or-false? t (typep (make-array '(3 3)) '(simple-array t (3 3))))
(true-or-false? nil (typep (make-array '(3 2 1)) '(simple-array t (1 2 3)))))
(define-test list-type-specifiers-hierarchy
;; Type specifiers that are lists also follow hierarchy.
(true-or-false? t (subtypep '(simple-array t (3 3)) '(simple-array t *)))
(true-or-false? t (subtypep '(vector double-float 100) '(vector * 100)))
(true-or-false? t (subtypep '(vector double-float 100) '(vector double-float *)))
(true-or-false? t (subtypep '(vector double-float 100) '(vector * *)))
(true-or-false? t (subtypep '(vector double-float 100) '(array * *)))
(true-or-false? t (subtypep '(vector double-float 100) t)))
(define-test type-coercion
(assert-true (typep 0 'integer))
(true-or-false? nil (typep 0 'short-float))
(true-or-false? nil (subtypep 'integer 'short-float))
(true-or-false? nil (subtypep 'short-float 'integer))
;; The function COERCE makes it possible to convert values between some
;; standard types.
(true-or-false? t (typep (coerce 0 'short-float) 'short-float)))
(define-test atoms-are-anything-thats-not-a-cons
;; In Lisp, an atom is anything that is not a cons cell. The function ATOM
;; returns true if its object is an atom.
(true-or-false? t (atom 4))
(true-or-false? nil (atom '(1 2 3 4)))
(true-or-false? nil (atom '(:foo . :bar)))
(true-or-false? t (atom 'symbol))
(true-or-false? t (atom :keyword))
(true-or-false? t (atom #(1 2 3 4 5)))
(true-or-false? t (atom #\A))
(true-or-false? t (atom "string"))
(true-or-false? t (atom (make-array '(4 4)))))
(define-test functionp
;; The function FUNCTIONP returns true if its arguments is a function.
(assert-true (functionp (lambda (a b c) (+ a b c))))
(true-or-false? t (functionp #'make-array))
(true-or-false? nil (functionp 'make-array))
(true-or-false? t (functionp (lambda (x) (* x x))))
(true-or-false? nil (functionp '(lambda (x) (* x x))))
(true-or-false? nil (functionp '(1 2 3)))
(true-or-false? nil (functionp t)))
(define-test other-type-predicates
;; Lisp defines multiple type predicates for standard types..
(true-or-false? t (numberp 999))
(true-or-false? t (listp '(9 9 9)))
(true-or-false? t (integerp 999))
(true-or-false? t (rationalp 9/99))
(true-or-false? t (floatp 9.99))
(true-or-false? t (stringp "nine nine nine"))
(true-or-false? t (characterp #\9))
(true-or-false? t (bit-vector-p #*01001)))
(define-test guess-that-type
;; Fill in the blank with a type specifier that satisfies the following tests.
(let ((type '(simple-array array (5 3 *))))
(assert-true (subtypep type '(simple-array * (* 3 *))))
(assert-true (subtypep type '(simple-array * (5 * *))))
(assert-true (subtypep type '(simple-array array *)))
(assert-true (typep (make-array '(5 3 9) :element-type 'string) type))
(assert-true (typep (make-array '(5 3 33) :element-type 'vector) type))))

88
lisp-koans/koans-solved/variables-parameters-constants.lisp Normal file
View File

@@ -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))

54
lisp-koans/koans-solved/vectors.lisp Normal file
View File

@@ -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))