first commit.

"Programs must be written for people to read, and only incidentally for machines to execute."
-- Abelson & Sussman, SCIP, preface to the first edition

.gitignore

+# ignore some editor temp files
+*~
+.#*
+.*.sw?

LICENSE

+
+                                 Apache License
+                           Version 2.0, January 2004
+                        http://www.apache.org/licenses/
+
+   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
+
+   1. Definitions.
+
+      "License" shall mean the terms and conditions for use, reproduction,
+      and distribution as defined by Sections 1 through 9 of this document.
+
+      "Licensor" shall mean the copyright owner or entity authorized by
+      the copyright owner that is granting the License.
+
+      "Legal Entity" shall mean the union of the acting entity and all
+      other entities that control, are controlled by, or are under common
+      control with that entity. For the purposes of this definition,
+      "control" means (i) the power, direct or indirect, to cause the
+      direction or management of such entity, whether by contract or
+      otherwise, or (ii) ownership of fifty percent (50%) or more of the
+      outstanding shares, or (iii) beneficial ownership of such entity.
+
+      "You" (or "Your") shall mean an individual or Legal Entity
+      exercising permissions granted by this License.
+
+      "Source" form shall mean the preferred form for making modifications,
+      including but not limited to software source code, documentation
+      source, and configuration files.
+
+      "Object" form shall mean any form resulting from mechanical
+      transformation or translation of a Source form, including but
+      not limited to compiled object code, generated documentation,
+      and conversions to other media types.
+
+      "Work" shall mean the work of authorship, whether in Source or
+      Object form, made available under the License, as indicated by a
+      copyright notice that is included in or attached to the work
+      (an example is provided in the Appendix below).
+
+      "Derivative Works" shall mean any work, whether in Source or Object
+      form, that is based on (or derived from) the Work and for which the
+      editorial revisions, annotations, elaborations, or other modifications
+      represent, as a whole, an original work of authorship. For the purposes
+      of this License, Derivative Works shall not include works that remain
+      separable from, or merely link (or bind by name) to the interfaces of,
+      the Work and Derivative Works thereof.
+
+      "Contribution" shall mean any work of authorship, including
+      the original version of the Work and any modifications or additions
+      to that Work or Derivative Works thereof, that is intentionally
+      submitted to Licensor for inclusion in the Work by the copyright owner
+      or by an individual or Legal Entity authorized to submit on behalf of
+      the copyright owner. For the purposes of this definition, "submitted"
+      means any form of electronic, verbal, or written communication sent
+      to the Licensor or its representatives, including but not limited to
+      communication on electronic mailing lists, source code control systems,
+      and issue tracking systems that are managed by, or on behalf of, the
+      Licensor for the purpose of discussing and improving the Work, but
+      excluding communication that is conspicuously marked or otherwise
+      designated in writing by the copyright owner as "Not a Contribution."
+
+      "Contributor" shall mean Licensor and any individual or Legal Entity
+      on behalf of whom a Contribution has been received by Licensor and
+      subsequently incorporated within the Work.
+
+   2. Grant of Copyright License. Subject to the terms and conditions of
+      this License, each Contributor hereby grants to You a perpetual,
+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+      copyright license to reproduce, prepare Derivative Works of,
+      publicly display, publicly perform, sublicense, and distribute the
+      Work and such Derivative Works in Source or Object form.
+
+   3. Grant of Patent License. Subject to the terms and conditions of
+      this License, each Contributor hereby grants to You a perpetual,
+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+      (except as stated in this section) patent license to make, have made,
+      use, offer to sell, sell, import, and otherwise transfer the Work,
+      where such license applies only to those patent claims licensable
+      by such Contributor that are necessarily infringed by their
+      Contribution(s) alone or by combination of their Contribution(s)
+      with the Work to which such Contribution(s) was submitted. If You
+      institute patent litigation against any entity (including a
+      cross-claim or counterclaim in a lawsuit) alleging that the Work
+      or a Contribution incorporated within the Work constitutes direct
+      or contributory patent infringement, then any patent licenses
+      granted to You under this License for that Work shall terminate
+      as of the date such litigation is filed.
+
+   4. Redistribution. You may reproduce and distribute copies of the
+      Work or Derivative Works thereof in any medium, with or without
+      modifications, and in Source or Object form, provided that You
+      meet the following conditions:
+
+      (a) You must give any other recipients of the Work or
+          Derivative Works a copy of this License; and
+
+      (b) You must cause any modified files to carry prominent notices
+          stating that You changed the files; and
+
+      (c) You must retain, in the Source form of any Derivative Works
+          that You distribute, all copyright, patent, trademark, and
+          attribution notices from the Source form of the Work,
+          excluding those notices that do not pertain to any part of
+          the Derivative Works; and
+
+      (d) If the Work includes a "NOTICE" text file as part of its
+          distribution, then any Derivative Works that You distribute must
+          include a readable copy of the attribution notices contained
+          within such NOTICE file, excluding those notices that do not
+          pertain to any part of the Derivative Works, in at least one
+          of the following places: within a NOTICE text file distributed
+          as part of the Derivative Works; within the Source form or
+          documentation, if provided along with the Derivative Works; or,
+          within a display generated by the Derivative Works, if and
+          wherever such third-party notices normally appear. The contents
+          of the NOTICE file are for informational purposes only and
+          do not modify the License. You may add Your own attribution
+          notices within Derivative Works that You distribute, alongside
+          or as an addendum to the NOTICE text from the Work, provided
+          that such additional attribution notices cannot be construed
+          as modifying the License.
+
+      You may add Your own copyright statement to Your modifications and
+      may provide additional or different license terms and conditions
+      for use, reproduction, or distribution of Your modifications, or
+      for any such Derivative Works as a whole, provided Your use,
+      reproduction, and distribution of the Work otherwise complies with
+      the conditions stated in this License.
+
+   5. Submission of Contributions. Unless You explicitly state otherwise,
+      any Contribution intentionally submitted for inclusion in the Work
+      by You to the Licensor shall be under the terms and conditions of
+      this License, without any additional terms or conditions.
+      Notwithstanding the above, nothing herein shall supersede or modify
+      the terms of any separate license agreement you may have executed
+      with Licensor regarding such Contributions.
+
+   6. Trademarks. This License does not grant permission to use the trade
+      names, trademarks, service marks, or product names of the Licensor,
+      except as required for reasonable and customary use in describing the
+      origin of the Work and reproducing the content of the NOTICE file.
+
+   7. Disclaimer of Warranty. Unless required by applicable law or
+      agreed to in writing, Licensor provides the Work (and each
+      Contributor provides its Contributions) on an "AS IS" BASIS,
+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+      implied, including, without limitation, any warranties or conditions
+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
+      PARTICULAR PURPOSE. You are solely responsible for determining the
+      appropriateness of using or redistributing the Work and assume any
+      risks associated with Your exercise of permissions under this License.
+
+   8. Limitation of Liability. In no event and under no legal theory,
+      whether in tort (including negligence), contract, or otherwise,
+      unless required by applicable law (such as deliberate and grossly
+      negligent acts) or agreed to in writing, shall any Contributor be
+      liable to You for damages, including any direct, indirect, special,
+      incidental, or consequential damages of any character arising as a
+      result of this License or out of the use or inability to use the
+      Work (including but not limited to damages for loss of goodwill,
+      work stoppage, computer failure or malfunction, or any and all
+      other commercial damages or losses), even if such Contributor
+      has been advised of the possibility of such damages.
+
+   9. Accepting Warranty or Additional Liability. While redistributing
+      the Work or Derivative Works thereof, You may choose to offer,
+      and charge a fee for, acceptance of support, warranty, indemnity,
+      or other liability obligations and/or rights consistent with this
+      License. However, in accepting such obligations, You may act only
+      on Your own behalf and on Your sole responsibility, not on behalf
+      of any other Contributor, and only if You agree to indemnify,
+      defend, and hold each Contributor harmless for any liability
+      incurred by, or claims asserted against, such Contributor by reason
+      of your accepting any such warranty or additional liability.
+
+   END OF TERMS AND CONDITIONS

README

+Getting Started
+---------------
+
+From a terminal, execute your lisp interpreter on the file 'contemplate.lsp' e.g.
+
+    sbcl --script contemplate.lsp
+
+Running on a fresh version should output the following:
+
+"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
+Thinking about ASSERTS
+    ASSERT-TRUE has damaged your karma.
+
+You have not yet reached enlightenment ...
+  A koan is incomplete.
+
+Please meditate on the following code:
+   File "koans/asserts.lsp"
+   Koan "ASSERT-TRUE"
+   Current koan assert status is "(INCOMPLETE)"
+
+You are now 0/169 koans and 0/25 lessons away from reaching enlightenment
+"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
+
+
+This indicates that the script has completed, and that the learner should look
+to asserts.lsp to locate and fix the problem.  The problem will be within 
+a define-test block such as
+
+    (define-test assert-true
+        "t is true.  Replace the blank with a t"
+        (assert-true ___))
+
+In this case, the test is incomplete, and the student should fill 
+in the blank (____) with appropriate lisp code to make the assert pass.
+
+
+In order to test code, or evaluate tests interactively, students may copy
+and paste code into the lisp command line REPL.
+
+
+Quoting the Ruby Koans instructions::
+-------------------------------------
+
+   "In test-driven development the mantra has always been, red, green, 
+refactor. Write a failing test and run it (red), make the test pass (green),
+then refactor it (that is look at the code and see if you can make it any
+better. In this case you will need to run the koan and see it fail (red), make
+the test pass (green), then take a moment and reflect upon the test to see what
+it is teaching you and improve the code to better communicate its
+intent (refactor)."
+
+
+Content
+-------
+
+The Common Lisp koans are based on the python koans and ruby koans projects.
+Additionally, many of the tests are based on new material that is special
+to Common Lisp.
+
+Note that the unit on threads uses an SBCL specific threading API.

TODO

+*  replace koans/threads.lsp with a more general thread library
+*  make get-error-filename more maintainable
+*  make get-error-koan-name more maintainable
+*  make get-error-koan-status more maintainable
+
+

contemplate.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+(in-package :cl-user)
+
+;; lisp-unit defines the modules for loading / executing koans
+(load "lisp-unit.lsp")
+
+(defpackage :lisp-koans
+  (:use :common-lisp)
+  (:use :lisp-unit)
+  (:use :sb-ext))
+
+(in-package :lisp-koans)
+
+;; .koans file controls which files in *koan-dir-name* are loaded as
+;; koans to complete
+(defvar *koan-dir-name* "koans")
+(with-open-file (in #P".koans")
+  (with-standard-io-syntax
+    (defvar *all-koans-groups* (read in))))
+
+;; set *print-koan-progress* to t to list all completed koans before summary
+(defvar *print-koan-progress* t)
+;; debug-print directives
+(defvar *dp-loading* nil)
+
+
+;; Global state used to hold results of loading and processing koans
+(defvar *n-total-koans* 0)
+(defvar *collected-results* nil)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Functions for loading koans ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun load-koan-group-named (koan-group-name)
+  ;; Creates a package for the koan-group based on koan-group-name.
+  ;; Loads a lisp file at *koan-dir-name* / koan-group-name .lsp
+  ;; Adds all the koans from that file to the package.
+  (let ((koan-file-name (concatenate 'string (string-downcase (string koan-group-name)) ".lsp")))
+    (if *dp-loading* (format t "start loading ~A ~%" koan-file-name))
+    (in-package :lisp-koans)
+    (make-package koan-group-name
+        :use '(:common-lisp :lisp-unit :sb-ext))
+    (setf *package* (find-package koan-group-name))
+    (load (concatenate 'string *koan-dir-name* "/" koan-file-name))
+    (incf *n-total-koans* (length (list-tests)))
+    (in-package :lisp-koans)
+    (if *dp-loading* (format t "done loading ~A ~%" koan-file-name))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Functions for executing koans ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun run-koan-group-named (koan-group-name)
+  ;; Executes the koan group, using run-koans defined in lisp-unit
+  ;; returning a test-results object.
+  (if *dp-loading* (format t "start running ~A ~%" koan-group-name))
+  (run-koans koan-group-name))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Functions for printing progress ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun print-one-koan-status (k-result)
+  (let ((koan-name (first k-result))
+        (all-pass-p (every
+                     #'(lambda (x) (equalp :pass x))
+                     (second k-result))))
+    (if all-pass-p
+        (format t "~A has expanded your awareness.~%" koan-name)
+        (format t "~A has damaged your karma.~%" koan-name))))
+
+(defun print-koan-group-progress (kg-name kg-results)
+  (format t "~%Thinking about ~A~%" kg-name)
+  (dolist (k-result (reverse kg-results))
+    (format t "    ")
+    (print-one-koan-status k-result))
+  (format t "~%"))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Functions for processing results ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun any-assert-non-pass-p ()
+   (dolist (k-group-result *collected-results*)
+     (dolist (koan-result (second k-group-result))
+       (dolist (one-assert (second koan-result))
+         (if (not (equal one-assert :pass))
+             (return-from any-assert-non-pass-p one-assert)))))
+   nil)
+
+(defun get-error-filename (collected-results)
+  (first (first (last collected-results))))
+
+(defun get-error-koan-name (collected-results)
+  (first (first (second (first (last (last collected-results)))))))
+
+(defun get-error-koan-status (collected-results)
+  (second (first (second (first (last (last collected-results)))))))
+
+(defun koan-status-message (koan-status)
+  (if (find :incomplete koan-status)
+       (return-from koan-status-message
+         "  A koan is incomplete.~%"))
+  (if (find :fail koan-status)
+       (return-from koan-status-message
+         "  A koan is incorrect.~%"))
+  (if (find :error koan-status)
+       (return-from koan-status-message
+         "  A koan threw an error.~%"))
+  (format t "  last koan status: ~A~%" koan-status)
+  "")
+
+(defun print-next-suggestion-message ()
+  (let ((filename (get-error-filename *collected-results*))
+        (koan-name (get-error-koan-name *collected-results*))
+        (koan-status (get-error-koan-status *collected-results*)))
+    (format t "You have not yet reached enlightenment ...~%")
+    (format t (koan-status-message koan-status))
+    (format t "~%")
+    (format t "Please meditate on the following code:~%")
+    (format t "   File \"~A/~A.lsp\"~%" *koan-dir-name* (string-downcase filename))
+    (format t "   Koan \"~A\"~%" koan-name)
+    (format t "   Current koan assert status is \"~A\"~%" (reverse koan-status))))
+
+(defun print-completion-message ()
+  (format t "That was the last one, well done!~%")
+  (format t "If you want more, take a look at extra-credit.lsp~%"))
+
+(defun n-completed-koans (collected-results)
+  (loop for kg in collected-results
+        sum (length (second kg)) into partial-sum
+        finally (return partial-sum)))
+
+(defun all-asserts-passed-in-koan-p (koan-result)
+  (equal
+   (length (second koan-result))
+   (count :pass (second koan-result))))
+
+(defun n-passed-koans-in-group (kg)
+  (loop for k in (second kg)
+        counting (all-asserts-passed-in-koan-p k) into partial-sum
+        finally (return partial-sum)))
+
+(defun n-passed-koans-overall (collected-results)
+  (loop for kg in collected-results
+        sum (n-passed-koans-in-group kg) into partial-sum
+        finally (return partial-sum)))
+
+(defun print-progress-message ()
+      (format t "You are now ~A/~A koans and ~A/~A lessons away from reaching enlightenment~%~%"
+              (n-passed-koans-overall *collected-results*)
+              *n-total-koans*
+              (- (length *collected-results*) 1)
+              (length *all-koans-groups*)))
+
+
+;;;;;;;;;;
+;; Main ;;
+;;;;;;;;;;
+
+;; Load all the koans before testing any, and
+;; count how many total koans there are.
+(loop for koan-group-name in *all-koans-groups*
+      do
+   (load-koan-group-named koan-group-name))
+
+;; Run through the koans until reaching the end condition.
+;; Store the results in *collected-results*
+(setf *collected-results*
+      (loop for koan-group-name in *all-koans-groups*
+            for kg-results = (run-koan-group-named koan-group-name)
+            collect (list koan-group-name kg-results)
+            do (if *print-koan-progress*
+                   (print-koan-group-progress koan-group-name kg-results))
+               ;; *proceed-after-failure* is defined in lisp-unit
+            until (and (not *proceed-after-failure*) (any-non-pass-p kg-results))))
+
+
+;; Output advice to the learner
+(if (any-assert-non-pass-p)
+    (progn
+      (print-next-suggestion-message)
+      (format t "~%")
+      (print-progress-message))
+    (print-completion-message))

koans/GREED_RULES.txt

+= 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.

koans/arrays.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+;; see http://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node157.html
+
+
+(define-test test-basic-array-stuff
+    " the first block of code defines an 8x8 array, then fills
+      the elements with a checkerboard pattern"
+  (let ((chess-board))
+    (setf chess-board (make-array '(8 8)))
+    "this dotimes is an iterator which loops x over integers 0 to 7"
+    (dotimes (x 8)
+      (dotimes (y 8)
+        (if (evenp (+ x y))
+            (setf (aref chess-board x y) :black)
+            (setf (aref chess-board x y) :white)
+            )))
+    (assert-true (typep chess-board 'array))
+    (assert-equal (aref chess-board 0 0) ___)
+    (assert-equal (aref chess-board 2 3) ___)
+    "array-rank returns the number of dimensions of the array"
+    (assert-equal ___ (array-rank chess-board))
+    "array-dimensions returns a list of the cardinality of the array dims"
+    (assert-equal ___ (array-dimensions chess-board))
+    (assert-equal ___ (array-total-size chess-board))))
+
+(define-test test-make-your-own-array
+    "make your own array that meets the specifications below."
+  (let ((color-cube nil))
+    "you may need to modify your array after you make it"
+    (if (typep color-cube '(simple-array T (3 3 3)))
+        (progn
+          (assert-equal 3 (array-rank color-cube))
+          (assert-equal '(3 3 3) (array-dimensions color-cube))
+          (assert-equal 27 (array-total-size color-cube))
+          (assert-equal (aref color-cube 0 1 2) :red)
+          (assert-equal (aref color-cube 2 1 0) :white))
+        (assert-true nil))))
+
+
+(define-test test-adjustable-array
+    "one may build arrays that can change size"
+  (let ((x (make-array '(2 2) :initial-element 5 :adjustable t)))
+    (assert-equal (aref x 1 0) 5)
+    (assert-equal (array-dimensions x) '(2 2))
+    (adjust-array x '(3 4))
+    (assert-equal (array-dimensions x) '(3 4))
+    (assert-equal (aref x 2 3) ____)))
+
+
+(define-test test-make-array-from-list
+  (let ((x))
+    (setf x (make-array '(4) :initial-contents '(:one :two :three :four)))
+    (assert-equal (array-dimensions x) ____)
+    (assert-equal ____ (aref x 0))))
+
+
+(define-test test-row-major-index
+    "row major indexing is a way to access elements with a single integer,
+     rather than a list of integers"
+  (let ((my-array nil))
+    (setf my-array (make-array '(2 2 2 2)))
+    (dotimes (i (* 2 2 2 2))
+      (setf (row-major-aref my-array i) i))
+    (assert-equal (aref my-array 0 0 0 0) ____)
+    (assert-equal (aref my-array 1 1 1 1) ____)))

koans/asserts.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+; Concept: What do you do to go through the lisp koans?  You fill in
+; the blanks, or otherwise fix the lisp code so that the
+; code within the 'define-koan' blocks passes.
+
+
+; In common lisp, "True" and "False" are represented by "t" and "nil".
+; More in a future lesson, but for now, consider t to be true,
+; and nil to be false.
+
+
+(define-test assert-true
+    "t is true.  Replace the blank with a t"
+    (assert-true ___))
+
+(define-test assert-false
+    "nil is false"
+    (assert-false ___))
+
+(define-test fill-in-the-blank
+    "sometimes you will need to fill the blank to complete"
+    (assert-equal 2 ___))
+
+(define-test fill-in-the-blank-string
+    (assert-equal ___ "hello world"))
+
+(define-test test-true-or-false
+    "sometimes you will be asked to evaluate whether statements 
+     are true (t) or false (nil)"
+    (true-or-false? ___ (equal 34 34))
+    (true-or-false? ___ (equal 19 78)))
+
+

koans/atoms-vs-lists.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+(define-test test-list-or-atom
+    "Lists in lisp are forms beginning and ending with rounded parentheses.
+     Atoms are symbols, numbers, or other forms usually separated by
+     white-space or parentheses.  The function 'listp' will return true iff
+     the input is a list.  The function 'atom' will return true iff the
+     input is an atom."
+  (true-or-false? ___ (listp '(1 2 3)))
+  (true-or-false? ___ (atom '(1 2 3)))
+
+  (true-or-false? ___ (listp '("heres" "some" "strings")))
+  (true-or-false? ___ (atom '("heres" "some" "strings")))
+
+  (true-or-false? ___ (listp "a string"))
+  (true-or-false? ___ (atom "a string"))
+
+  (true-or-false? ___ (listp 2))
+  (true-or-false? ___ (atom 2))
+
+  (true-or-false? ___ (listp '(("first" "list") ("second" "list"))))
+  (true-or-false? ___ (atom '(("first" "list") ("second" "list")))))
+
+
+(define-test test-empty-list-is-both-list-and-atom
+    "the empty list, nil, is unique in that it is both a list and an atom"
+  (true-or-false? ___ (listp nil))
+  (true-or-false? ___ (atom nil)))
+
+
+(define-test test-keywords
+    "symbols like :hello or :like-this are treated differently in lisp.
+     Called keywords, they are symbols that evaluate to themselves."
+  (true-or-false? ___ (equal :this-is-a-keyword :this-is-a-keyword))
+  (true-or-false? ___ (equal :this-is-a-keyword ':this-is-a-keyword)))

koans/clos.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+;; CLOS stands for Common Lisp Object System.
+;; CLOS is common lisps' object oriented framework.
+
+(defclass racecar () (color speed))
+
+(define-test test-defclass
+    (let ((car-1 (make-instance 'racecar))
+          (car-2 (make-instance 'racecar)))
+      (setf (slot-value car-1 'color) :red)
+      (setf (slot-value car-1 'speed) 220)
+      (setf (slot-value car-2 'color) :blue)
+      (setf (slot-value car-2 'speed) 240)
+      (assert-equal ____ (slot-value car-1 'color))
+      (assert-equal ____ (slot-value car-2 'speed))))
+
+;; CLOS provides functionality for creating getters / setters
+;; for defined objects
+
+(defclass spaceship ()
+  ((color :reader get-color :writer set-color)
+   (speed :reader get-speed :writer set-speed)))
+
+(define-test test-clos-getters-and-setters
+    (let ((ship-1 (make-instance 'spaceship)))
+      (set-color :orange ship-1)
+      (assert-equal ____ (get-color ship-1))
+      (set-speed 1000 ship-1)
+      (assert-equal ____ (get-speed ship-1))))
+
+;; CLOS also provides functionality to create accessors
+;; to object data.
+
+;; stores a value, and a counter which tallies accesses, read or write,
+;; to that value
+(defclass value-with-access-counter ()
+  ((value :reader get-value :writer set-value :initform 0)
+   (access-count :reader how-many-value-queries :initform 0)))
+
+(defmethod get-value ((object value-with-access-counter))
+           (incf (slot-value object 'access-count))
+           (slot-value object 'value))
+
+(defmethod set-value (new-value (object value-with-access-counter))
+           (incf (slot-value object 'access-count))
+           (setf (slot-value object 'value) new-value))
+
+(define-test test-access-counter
+    (let ((x (make-instance 'value-with-access-counter)))
+      ; check that no one has ever looked at the x value yet.
+      (assert-equal ____ (how-many-value-queries x))
+      ; check that the default value is zero.
+      (assert-equal ___ (get-value x))
+      ; now that we've looked at it, there is a single access.
+      (assert-equal ___ (how-many-value-queries x))
+      ; check that we can set and read the value
+      (set-value 33 x)
+      (assert-equal 33 (get-value x))
+      (assert-equal ___ (how-many-value-queries x))))
+
+
+; countdowner has a value which goes down every time you look at it
+; and returns "bang" when it hits zero.
+(defclass countdowner ()
+  ((value :initform 4)))
+
+;; Write the get-value for the countdowner
+;; to satisfy the test-countdowner tests.
+;; you may be interested in the 'decf function.
+(defmethod get-value ((object countdowner))
+  :WRITE-ME)
+
+
+(define-test test-countdowner
+    (let ((c (make-instance 'countdowner)))
+      (assert-equal 3 (get-value c))
+      (assert-equal 2 (get-value c))
+      (assert-equal 1 (get-value c))
+      (assert-equal "bang" (get-value c))
+      (assert-equal "bang" (get-value c))))
+
+
+;; Classes can inherit data and methods from other classes.
+;; Here, the specific CIRCLE class extends the generic SHAPE class
+(defclass shape ()
+  ((kind :reader get-kind :writer set-kind :initform :default-shape-kind)
+   (pos :reader get-pos :writer set-pos :initform '(0 0))))
+
+(defclass circle (shape)
+  ((radius :reader get-radius :writer set-radius :initform 0)))
+
+(define-test test-inheritance
+    (let ((circle-1 (make-instance 'circle))
+          (shape-1 (make-instance 'shape)))
+      (assert-equal ____ (type-of shape-1))
+      (assert-equal ____ (type-of circle-1))
+      (true-or-false? ____ (typep circle-1 'circle))
+      (true-or-false? ____ (typep circle-1 'shape))
+      (set-kind :circle circle-1)
+      (set-pos '(3 4) circle-1)
+      (set-radius 5 circle-1)
+      (assert-equal ____ (get-pos circle-1))
+      (assert-equal ____ (get-radius circle-1))))
+
+;; Classes may also inherit from more than one base class.
+;; This is known as multiple inheritance.
+
+;; Color holds an rgb triplet and a transparency alpha value.
+;; The RGB stands for the amount of red, green, and blue.
+;; the alpha (transparency) value is 0 for completely opaque.
+;; Note that color also has a kind, like shape.
+
+(defclass color ()
+  ((rgb :reader get-rgb :writer set-rgb :initform '(0 0 0))
+   (alpha :reader get-alpha :writer set-alpha :initform 0)
+   (kind :reader get-kind :writer set-kind :initform :default-color-kind)))
+
+;; The COLORED-CIRCLE class extends both CIRCLE and COLOR.
+;; Of particular interest is which "kind" slot will COLORED-CIRCLE get,
+;; since both CIRCLE and COLOR provide the "kind" slot.
+
+(defclass colored-circle (color circle) ())
+(defclass circled-color (circle color) ())
+
+(define-test test-multiple-inheritance
+    (let ((my-colored-circle (make-instance 'colored-circle))
+          (my-circled-color (make-instance 'circled-color)))
+      (assert-equal ____ (get-kind my-colored-circle))
+      (assert-equal ____ (get-kind my-circled-color))))
+
+
+(defvar *last-kind-accessor* nil)
+
+(defmethod get-kind ((object shape))
+           (setf *last-kind-accessor* :shape)
+           (slot-value object 'kind))
+
+(defmethod get-kind ((object circle))
+           (setf *last-kind-accessor* :circle)
+           (slot-value object 'kind))
+
+(defmethod get-kind ((object color))
+           (setf *last-kind-accessor* :color)
+           (slot-value object 'kind))
+
+;; Precedence order is similarly a depth first search for methods.
+
+(define-test test-multiple-inheritance-method-order
+    (let ((my-colored-circle (make-instance 'colored-circle))
+          (my-circled-color (make-instance 'circled-color))
+          (my-shape (make-instance 'shape))
+          (my-circle (make-instance 'circle))
+          (my-color (make-instance 'color)))
+      (get-kind my-shape)
+      (assert-equal ____ *last-kind-accessor*)
+      (get-kind my-circle)
+      (assert-equal ____ *last-kind-accessor*)
+      (get-kind my-color)
+      (assert-equal ____ *last-kind-accessor*)
+      (get-kind my-colored-circle)
+      (assert-equal ____ *last-kind-accessor*)
+      (get-kind my-circled-color)
+      (assert-equal ____ *last-kind-accessor*)))
+
+
+;; Todo: consider adding :before and :after method control instructions.
+

koans/condition-handlers.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+"Common lisp conditions are much like CLOS classes.
+They are used to handle exceptional situations, and separate
+error handling code from normal operational code."
+
+(define-condition minimal-error-cond (error) ())
+(define-condition minimal-warning-cond (warning) ())
+
+
+(define-test test-conditions-derive-from-types
+    "conditions inherit from base types"
+  (true-or-false? ___ (typep (make-condition 'minimal-error-cond)
+                             'minimal-error-cond))
+
+  (true-or-false? ___ (typep (make-condition 'minimal-error-cond)
+                             'error))
+
+  (true-or-false? ___ (typep (make-condition 'minimal-error-cond)
+                             'warning))
+
+  (true-or-false? ___ (typep (make-condition 'minimal-warning-cond)
+                             'minimal-warning-cond))
+
+  (true-or-false? ___ (typep (make-condition 'minimal-warning-cond)
+                             'error))
+
+  (true-or-false? ___ (typep (make-condition 'minimal-warning-cond)
+                             'warning)))
+
+
+;; ----
+
+
+(define-condition my-div-by-zero-error (error) ())
+(define-condition my-non-number-args-error (error) ())
+
+(defun my-divide (num denom)
+  (if (or (not (numberp num))
+          (not (numberp denom)))
+      (error 'my-non-number-args-error))
+  (if (= 0 denom)
+      (error 'my-div-by-zero-error)
+      (/ num denom)))
+
+(define-test assert-error-thrown
+    "assert-error checks that the right error is thrown"
+  (assert-equal 3 (my-divide 6 2))
+  (assert-error 'my-div-by-zero-error (my-divide 6 0))
+  (assert-error ____ (my-divide 6 "zero")))
+
+
+(define-test test-handle-errors
+    "the handler case is like a case statement which can capture errors
+     and warnings, and execute appropriate forms in those conditions."
+  (assert-equal ___
+                (handler-case (my-divide 6 2)
+                  (my-div-by-zero-error (condition) :zero-div-error)
+                  (my-non-number-args-error (condition) :bad-args))
+  (assert-equal ___
+                (handler-case (my-divide 6 0)
+                  (my-div-by-zero-error (condition) :zero-div-error)
+                  (my-non-number-args-error (condition) :bad-args)))
+  (assert-equal ___
+                (handler-case (my-divide 6 "woops")
+                  (my-div-by-zero-error (condition) :zero-div-error)
+                  (my-non-number-args-error (condition) :bad-args)))))
+
+
+;; ----
+
+"conditions, as CLOS objects, can have slots, some of which have special
+meanings.  Common Lisp the Language Chapter 29 for more details.
+http://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node312.html"
+
+; This error condition is more than a signal.  It carries data in two slots.
+; the "original-line" slot and the "reason" slot.  Both slots have a defined
+; :initarg, which they will use to set themselves, if available.  If not,
+; they have a default form (:initform).  They also both provide reader functions
+
+(define-condition logline-parse-error (error)
+  ((original-line :initarg :original-line :initform "line not given" :reader original-line)
+   (reason :initarg :reason :initform "no-reason" :reader reason)))
+
+
+;; This function is designed to take loglines, and report what type they are.
+;; It can also throw errors, like div-by-zero above, but the errors now carry some
+;;  additional information carried within the error itself.
+
+(defun get-logline-type (in-line)
+  (if (not (typep in-line 'string))
+      ;; if the in-line isn't a string, throw a logline-parse-error, and set the :reason and :original-line
+      (error 'logline-parse-error :original-line in-line :reason :bad-type-reason))
+  (cond
+    ((equal 0 (search "TIMESTAMP" in-line)) :timestamp-logline-type)
+    ((if (equal 0 (search "HTTP" in-line)) :http-logline-type))
+    ;; if we don't recognize the first token,  throw a logline-parse-error, and set the :reason and :original-line
+    (t (error 'logline-parse-error :original-line in-line :reason :unknown-token-reason))))
+
+
+(define-test test-errors-have-slots
+    (assert-equal ____
+                  (handler-case (get-logline-type "TIMESTAMP y13m01d03")
+                    (logline-parse-error (condition) (list (reason condition) (original-line condition)))))
+    (assert-equal ____
+                  (handler-case (get-logline-type "HTTP access 128.0.0.100")
+                    (logline-parse-error (condition) (list (reason condition) (original-line condition)))))
+    (assert-equal ____
+                  (handler-case (get-logline-type "bogus logline")
+                    (logline-parse-error (condition) (list (reason condition) (original-line condition)))))
+    (assert-equal ____
+                  (handler-case (get-logline-type 5555)
+                    (logline-parse-error (condition) (list (reason condition) (original-line condition))))))

koans/control-statements.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+(define-test test-if-then-else
+    (let ((result))
+      (if t
+          (setf result "true value")
+          (setf result "false value"))
+      (assert-equal result ____)
+      (if nil
+          (setf result "true value")
+          (setf result "false value"))
+      (assert-equal result ____)))
+
+
+(define-test test-when-and-unless
+    (let ((result-1 nil)
+          (result-2 nil)
+          (when-nums nil)
+          (unless-nums nil))
+      (dolist (x '(1 2 3 4 5 6 7 8 9 10))
+        (when (> x 5)
+          (setf result-1 x)
+          (push x when-nums))
+        (unless (> x 5)
+          (setf result-2 x)
+          (push x unless-nums)))
+      (assert-equal result-1 ___)
+      (assert-equal result-2 ___)
+      (assert-equal when-nums ___)
+      (assert-equal unless-nums ___)))
+
+
+(define-test test-and-short-circuits
+    "and only evaluates forms until one evaluates to nil"
+  (assert-equal
+   ____
+   (let ((x 0))
+     (and
+      (setf x (+ 1 x))
+      (setf x (+ 1 x))
+      nil ;; <- ends execution of and.
+      (setf x (+ 1 x)))
+     x)))
+
+
+(define-test test-or-also-short-circuits
+    "or only evaluates until one argument evaluates to non-nil"
+  (assert-equal
+   ____
+   (let ((x 0))
+     (or
+      (setf x (+ 1 x))
+      (setf x (+ 1 x))
+      nil
+      (setf x (+ 1 x)))
+     x)))

koans/dice-project.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+; based on about_dice_project.rb
+
+;; In this project we are going to build a CLOS class representing
+;; a simple set of dice.  There are only two operations on the dice,
+;; reading the values, and re-rolling.
+
+
+;;  YOU WRITE THIS PART:
+(defclass dice-set ()
+  () ;; WRITE DICE-SET CLASS BODY HERE
+)
+
+(defmethod get-values ((object dice-set))
+  ;; WRITE GET-VALUES METHOD DEFINITION HERE
+)
+
+(defmethod roll (how-many (object dice-set))
+  ;; WRITE ROLL METHOD DEFINITION HERE
+)
+
+
+(define-test test-create-dice-set
+;; tests making an instance of the dice-set
+    (let ((dice (make-instance 'dice-set)))
+      (assert-true dice)))
+
+
+(define-test test-rolling-the-dice-returns-a-set-of-integers-between-1-and-6
+;; tests rolling the dice
+    (let ((dice (make-instance 'dice-set)))
+      (roll 5 dice)
+      (assert-true (typep (get-values dice) 'list))
+      (assert-equal 5 (length (get-values dice)))
+      (dolist (x (get-values dice))
+        (assert-true (and (>= x 1)
+                          (<= x 6)
+                          (typep x 'integer))))))
+
+
+(define-test test-dice-values-do-not-change-unless-explicitly-rolled
+;; tests that dice don't change just by looking at them
+    (let ((dice (make-instance 'dice-set)))
+      (roll 100 dice)
+      (let ((first-time (get-values dice))
+            (second-time (get-values dice)))
+        (assert-equal first-time second-time))))
+
+
+(define-test test-dice-values-should-change-between-rolls
+;; tests that rolling the dice DOES change the values.
+    (let ((dice (make-instance 'dice-set))
+          (first-time nil)
+          (second-time nil))
+      (roll 100 dice)
+      (setf first-time (get-values dice))
+      (roll 100 dice)
+      (setf second-time (get-values dice))
+      (assert-false (equal first-time second-time))))
+
+(define-test test-you-can-roll-different-numbers-of-dice
+;; tests count parameter of how many dice to roll
+    (let ((dice (make-instance 'dice-set)))
+      (assert-equal 5 (length (roll 5 dice)))
+      (assert-equal 100 (length (roll 100 dice)))
+      (assert-equal 1 (length (roll 1 dice)))))

koans/equality-distinctions.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+;; the most common equality predicates are eq, eql, equal and equalp
+;; eq is similar to comparing c pointers
+(define-test test-eq
+    "(eq x y) is true if and only if x and y are the same identical object
+     eq is like comparing pointers in c.  If the values are EQ, any non-nil
+     value may be returned."
+  (true-or-false? ___ (eq 'a 'a))
+  (true-or-false? ___ (eq 3 3.0))
+  (true-or-false? ___ (eq '(1 2) '(1 2)))
+  (true-or-false? ___ (eq "Foo" "Foo"))
+  (true-or-false? ___ (eq "Foo" (copy-seq "Foo")))
+  (true-or-false? ___ (eq "FOO" "Foo")))
+
+(define-test test-eql
+    "(eql x y) is true if (eq x y)
+     also it is true if x and y are numeric of the same type
+     and represent the same number.
+     (eql x y) also if x and y are the same characters."
+   (true-or-false? ___ (eql 'a 'a))
+   (true-or-false? ___ (eql 3 3))
+   (true-or-false? ___ (eql 3 3.0))
+   (true-or-false? ___ (eql '(1 2) '(1 2)))
+   (true-or-false? ___ (eql  '(:a . :b) '(:a . :b)))
+   (true-or-false? ___ (eql #\S #\S))
+   (true-or-false? ___ (eql "Foo" "Foo"))
+   (true-or-false? ___ (eql "Foo" (copy-seq "Foo")))
+   (true-or-false? ___ (eql "FOO" "Foo")))
+
+(define-test test-equal
+    "(equal x y) is true if (eql x y), or
+     x and y are lists with equal elements, or
+     x and y character or bit arrays with equal elements"
+   (true-or-false? ___ (equal 'a 'a))
+   (true-or-false? ___ (equal 3 3))
+   (true-or-false? ___ (equal 3 3.0))
+   (true-or-false? ___ (equal '(1 2) '(1 2)))
+   (true-or-false? ___ (equal  '(:a . :b) '(:a . :b)))
+   (true-or-false? ___ (equal  '(:a . :b) '(:a . :doesnt-match)))
+   (true-or-false? ___ (equal #\S #\S))
+   (true-or-false? ___ (equal "Foo" "Foo"))
+   (true-or-false? ___ (equal "Foo" (copy-seq "Foo")))
+   (true-or-false? ___ (equal "FOO" "Foo")))
+
+(define-test test-equalp
+    "(equalp x y) if (equal x y) or
+     if x and y are strings with the same characters (case independent).
+     if x and y are arrays with the same dimensions and equal elements
+     if x and y are numeric of different types but one may be upgraded to
+     the other type without loss and still exhibit equality."
+   (true-or-false? ___ (equalp 'a 'a))
+   (true-or-false? ___ (equalp 3 3))
+   (true-or-false? ___ (equalp 3 3.0))
+   (true-or-false? ___ (equalp '(1 2) '(1 2)))
+   (true-or-false? ___ (equalp  '(:a . :b) '(:a . :b)))
+   (true-or-false? ___ (equalp  '(:a . :b) '(:a . :doesnt-match)))
+   (true-or-false? ___ (equalp #\S #\S))
+   (true-or-false? ___ (equalp "Foo" "Foo"))
+   (true-or-false? ___ (equalp "Foo" (copy-seq "Foo")))
+   (true-or-false? ___ (equalp "FOO" "Foo")))
+
+(define-test test-numeric-equal
+    "(= x y) is only for numerics
+     and can take multiple arguments
+     if x or y is not numeric there will be a compiler error."
+   (true-or-false? ___ (= 99.0 99 99.000))
+   (true-or-false? ___ (= 0 1 -1))
+   (true-or-false? ___ (= (/ 2 3) (/ 6 9) (/ 86 129))))

koans/evaluation.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+;; based on http://psg.com/~dlamkins/sl/chapter03-02.html
+
+(define-test test-function-name-is-first-argument
+    "In most imperative languages, the syntax of a function call has
+     the function name succeeded by a list of arguments.  In lisp,
+     the function name and arguments are all part of the same list,
+     with the function name the first element of that list."
+
+  "in these examples, the function names are +, -, and *"
+  (assert-equal ___ (+ 2 3))
+  (assert-equal ___ (- 1 3))
+  (assert-equal ___ (* 7 4))
+  "'>' and '=' are the boolean functions (predicates) 'greater-than' and
+   'equal to'"
+  (assert-equal ___ (> 100 4))
+  (assert-equal ___ (= 3 3))
+  "'NUMBERP' is a predicate which returns true if the argument is a number"
+  (assert-equal ___ (numberp 5))
+  (assert-equal ___ (numberp "five")))
+
+
+(define-test test-evaluation-order
+    "Arguments to functions are evaluated before the function"
+  (assert-equal ___ (* (+ 1 2) (- 13 10))))
+
+
+(define-test test-quoting-behavior
+    "Preceding a list with a quote (') will tell lisp not to evalute a list.
+     The quote special form suppresses normal evaluation, an instead returns
+     the literal list.
+     Evaluating the form (+ 1 2) returns the number 3,
+     but evaluating the form '(+ 1 2) returns the list (+ 1 2)"
+  (assert-equal ____ (+ 1 2))
+  (assert-equal ____ '(+ 1 2))
+  "'LISTP' is a predicate which returns true if the argument is a list"
+  " the '(CONTENTS) form defines a list literal containing CONTENTS"
+  (assert-equal ___ (listp '(1 2 3)))
+  (assert-equal ___ (listp 100))
+  (assert-equal ___ (listp "Word to your moms I came to drop bombs"))
+  (assert-equal ___ (listp nil))
+  (assert-equal ___ (listp (+ 1 2)))
+  (assert-equal ___ (listp '(+ 1 2)))
+  "equalp is an equality predicate"
+  (assert-equal ___ (equalp 3 (+ 1 2)))
+  "the '(xyz ghi) syntax is syntactic sugar for the (QUOTE (xyz ghi)) function."
+  (true-or-false? ___ (equalp '(/ 4 0) (quote (/ 4 0)))))

koans/extra-credit.lsp

+;; EXTRA CREDIT:
+;;
+;; Create a program that will play the Greed Game.
+;; Rules for the game are in GREED_RULES.TXT.
+;;
+;; You already have a DiceSet class and score function you can use.
+;; Write a player class and a Game class to complete the project.  This
+;; is a free form assignment, so approach it however you desire.

koans/functions.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+; borrows from about_methods.py
+
+(defun some-named-function (a b)
+  (+ a b))
+
+(define-test test-call-a-function
+    "DEFUN defines global functions"
+  (assert-equal ___ (some-named-function 7 11)))
+
+
+(define-test test-shadow-a-function
+    "Local functions are defined with FLET or LABELS.  One major difference
+     between the two is that local functions defined with LABELS may refer
+     to themselves, whereas local functions defined with FLET may not."
+   (assert-eq 18 (some-named-function 7 11))
+   "flet binds a function to a name within a lexical environment"
+   (flet ((some-named-function (a b) (* a b)))
+     (assert-equal ___ (some-named-function 7 11)))
+   (assert-equal ___  (some-named-function 7 11)))
+
+
+; borrowed from Common Lisp The Language chapter 5.2.2
+(defun func-with-opt-params (&optional (a 2) (b 3) )
+  ; each optional parameter has a form like (var default-val)
+  (list a b))
+
+(define-test test-optional-parameters
+    "Optional parameters are filled in with their default value."
+   (assert-equal (func-with-opt-params :test-1 :test-2) ___)
+   (assert-equal (func-with-opt-params :test-1) ___)
+   (assert-equal (func-with-opt-params) ___))
+
+
+;; ----
+
+
+(defun func-with-opt-params-and-indication (&optional (a 2 a?) (b 3 b?))
+  (list a a? b b?))
+
+(define-test test-optional-parameters-with-indication
+   "Common Lisp optional params may bind a symbol which indicate whether the
+    value was provided or defaulted.  Each optional parameter binding has the
+    form (var default-form supplied-p)."
+   (assert-equal (func-with-opt-params-and-indication :test-1 :test-2) ___)
+   (assert-equal (func-with-opt-params-and-indication :test-1) ___)
+   (assert-equal (func-with-opt-params-and-indication) ___))
+
+
+;; ----
+
+
+(defun func-with-rest-params (&rest x)
+  x)
+
+(define-test test-func-with-rest-params
+  "With &rest, the remaining params, are handed in as a list.  Remaining
+   arguments (possibly none) are collected into a list."
+  (assert-equal (func-with-rest-params) ___)
+  (assert-equal (func-with-rest-params 1) ___)
+   (assert-equal (func-with-rest-params 1 :two 333) ___))
+
+
+;; ----
+
+
+(defun func-with-key-params (&key a b)
+  (list a b))
+
+(defun test-key-params ()
+  "Key params allow the user to specify params in any order"
+   (assert-equal (func-with-key-params) ___)
+   (assert-equal (func-with-key-params :a 11 :b 22) ___)
+   ; it is not necessary to specify all key parameters
+   (assert-equal (func-with-key-params :b 22) ___)
+   ; order is not important
+   (assert-equal (func-with-key-params :b 22 :a 0) ___))
+
+(defun func-key-params-can-have-defaults (&key  (a 3 a?) (b 4 b?))
+  (list a a? b b?))
+
+(define-test test-key-params-can-have-defaults
+    "key parameters can have defaults also"
+   (assert-equal (func-key-params-can-have-defaults) ____)
+   (assert-equal (func-key-params-can-have-defaults :a 3 :b 4) ___)
+   (assert-equal (func-key-params-can-have-defaults :a 11 :b 22) ___)
+   (assert-equal (func-key-params-can-have-defaults :b 22) ___)
+   ; order is not important
+   (assert-equal (func-key-params-can-have-defaults :b 22 :a 0) ___))
+
+
+;; ----
+
+
+;; borrowed from common listp the language 5.2.2
+(defun func-with-funky-parameters (a &rest x &key b (c a))
+   (list a b c x))
+
+(define-test test-many-kinds-params
+    "CL provides the programmer with more than enough rope to hang himself."
+   (assert-equal (func-with-funky-parameters 1) ___)
+   (assert-equal (func-with-funky-parameters 1 :b 2) ___)
+   (assert-equal (func-with-funky-parameters 1 :b 2 :c 3) ___)
+   (assert-equal (func-with-funky-parameters 1 :c 3 :b 2) ___))
+
+
+;; Note that &rest parameters have to come before &key parameters.
+;; This is an error: (defun f (&key a &rest x) () )
+;; But this is ok:   (defun f (&rest x &key a) () )
+
+
+(define-test test-lambdas-are-nameless-functions
+    "A lambda form defines a function, but with no name.  It is possible
+     to execute that function immediately, or put it somewhere for later use."
+   (assert-equal 19 ((lambda (a b) (+ a b)) 10 9))
+  (let ((my-function))
+    (setf my-function (lambda (a b) (* a b)))
+    (assert-equal ___ (funcall my-function 11 9)))
+  (let ((list-of-functions nil))
+    (push (lambda (a b) (+ a b)) list-of-functions)
+    (push (lambda (a b) (* a b)) list-of-functions)
+    (push (lambda (a b) (- a b)) list-of-functions)
+    (assert-equal ___ (funcall (second list-of-functions) 2 33))))
+
+(define-test test-lambdas-can-have-optional-params
+   (assert-equal ___ ((lambda (a &optional (b 100)) (+ a b)) 10 9))
+   (assert-equal ___ ((lambda (a &optional (b 100)) (+ a b)) 10)))
+
+
+; returns sign x
+(defun sign-of (x)
+  (if (< x 0) (return-from where-to-return -1))
+  (if (eq x 0) (return-from where-to-return 0))
+  1)
+
+(define-test test-return-from-function-early
+   (assert-equal (sign-of -5.5) ___)
+   (assert-equal (sign-of 0) ___)
+   (assert-equal (sign-of ___) 1))
+
+
+;; ----
+
+
+;; Lambdas create "lexical closures", meaning that the resulting function, when
+;; called, will execute in an environment wherein the lexical bindings to all
+;; referred to names still apply.
+;; This example from "Common Lisp The Language" Ch. 7
+
+(defun adder (x)
+  "The result of (adder n) is a nameless function with one parameter.
+  This function will add n to its argument."
+  (lambda (y) (+ x y)))
+
+(defun test-lexical-closure-over-adder ()
+  (let ((add-100 (adder 100))
+        (add-500 (adder 500)))
+  "add-100 and add-500 now refer to different bindings to x"
+   (assert-equal ___ (funcall add-100 3))
+   (assert-equal ___ (funcall add-500 3))))
+
+
+;; ----
+
+
+;; The closure gives the returned function access to the bindings, not just the
+;; values.  This means that two functions which close over the same variables
+;; will always see the same values of those variables if one does a setq.
+
+(defun two-funs (x)
+  "Returns a list of two functions.
+   The first takes no parameters and returns x.
+   The second takes one parameter, y, and resets x to the value of y."
+  (list (function (lambda () x))
+        (function (lambda (y) (setq x y)))))
+
+(define-test test-lexical-closure-interactions
+    "An illustration of how lexical closures may interact."
+  (let ((tangled-funs-1 (two-funs 1))
+        (tangled-funs-2 (two-funs 2)))
+     (assert-equal (funcall (first tangled-funs-1)) ___)
+     (funcall (second tangled-funs-1) 0)
+     (assert-equal (funcall (first tangled-funs-1)) ___)
+
+     (assert-equal (funcall (first tangled-funs-2)) ___)
+     (funcall (second tangled-funs-2) 100)
+     (assert-equal (funcall (first tangled-funs-2)) ___)))
+
+
+(define-test test-apply-function-with-apply
+  "APPLY calls the function parameter on a list of all the remaining
+   parameters"
+  (let (f1 f2 f3)
+    (setq f1 '+)
+    (setq f2 '-)
+    (setq f3 'max)
+
+    (assert-equal ___ (apply f1 '(1 2)))
+    (assert-equal ___ (apply f2 '(1 2)))
+
+    ; after the function name, the parameters are consed onto the front
+    ; of the very last parameter
+    (assert-equal ___ (apply f1 1 2 '(3)))
+    (assert-equal ___ (apply f3 1 2 3 4 '()))))
+
+
+(define-test test-apply-function-with-funcall
+  "FUNCALL calls the function parameter on a list of all the remaining
+   parameters.  Remaining params do not expect a final list."
+  (let (f1 f2 f3)
+    (setq f1 '+)
+    (setq f2 '-)
+    (setq f3 'max)
+    (assert-equal ___ (funcall f1 1 2))
+    (assert-equal ___ (funcall f2 1 2))
+    (assert-equal ___ (funcall f1 1 2 3))
+    (assert-equal ___ (funcall f3 1 2 3 4))))

koans/hash-tables.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+; based on python koans: about_dictionaries.py
+
+
+(define-test test-create-hash-table
+    "make hash table with make-hash-table"
+  (let ((my-hash-table))
+    (setf my-hash-table (make-hash-table))
+    (true-or-false? ___ (typep my-hash-table 'hash-table))
+    (true-or-false? ___  (hash-table-p my-hash-table))
+    (true-or-false? ___  (hash-table-p (make-array '(3 3 3))))
+    (assert-equal ___ (hash-table-count my-hash-table))))
+
+
+(define-test test-hash-table-access
+    "gethash is for accessing hash tables"
+  (let ((table-of-cube-roots (make-hash-table)))
+
+  "assign the key-value pair 1->'uno'"
+  (setf (gethash 1 table-of-cube-roots) 1)
+  (assert-equal 1 (gethash 1 table-of-cube-roots))
+  (assert-equal 1 (hash-table-count table-of-cube-roots))
+
+  (setf (gethash 8 table-of-cube-roots) 2)
+  (setf (gethash -27 table-of-cube-roots) -3)
+  (assert-equal ___ (gethash -3 table-of-cube-roots))
+  (assert-equal ___ (hash-table-count table-of-cube-roots))
+
+  "accessing unset keys returns nil"
+  (assert-equal ___ (gethash 125 table-of-cube-roots))))
+
+
+(define-test test-hash-key-equality
+    "hash tables need to know how to tell if two keys are equivalent.
+     The programmer must be careful to know which equality predicate is right."
+  (let ((hash-table-eq nil)
+        (hash-table-equal nil)
+        (hash-table-default nil))
+
+    "define three hash tables, with different equality tests"
+    (setf hash-table-eq (make-hash-table :test #'eq))
+    (setf hash-table-equal (make-hash-table :test #'equal))
+    (setf hash-table-default (make-hash-table))
+
+    "add the same string twice, to each"
+    (setf (gethash "one" hash-table-eq) "uno")
+    (setf (gethash "one" hash-table-eq) "uno")
+
+    (setf (gethash "one" hash-table-equal) "uno")
+    (setf (gethash "one" hash-table-equal) "uno")
+
+    (setf (gethash "one" hash-table-default) "uno")
+    (setf (gethash "one" hash-table-default) "uno")
+
+    "count how many unique key-value pairs in each"
+    (assert-equal ___ (hash-table-count hash-table-eq))
+    (assert-equal ___ (hash-table-count hash-table-equal))
+    (assert-equal ___ (hash-table-count hash-table-default))))
+
+
+(define-test test-hash-table-equality
+    (let ((h1 (make-hash-table :test #'equal))
+          (h2 (make-hash-table :test #'equal)))
+      (setf (gethash "one" h1) "yat")
+      (setf (gethash "one" h2) "yat")
+      (setf (gethash "two" h1) "yi")
+      (setf (gethash "two" h2) "yi")
+      (true-or-false? ___ (eq h1 h2))
+      (true-or-false? ___ (equal h1 h2))
+      (true-or-false? ___ (equalp h1 h2))))
+
+
+(define-test test-changing-hash-tables
+    (let ((babel-fish (make-hash-table :test #'equal))
+          (expected (make-hash-table :test #'equal)))
+      (setf (gethash "one" babel-fish) "uno")
+      (setf (gethash "two" babel-fish) "dos")
+      (setf (gethash "one" expected) "ein")
+      (setf (gethash "two" expected) "zwei")
+
+      (setf (gethash "one" babel-fish) "ein")
+      (setf (gethash "two" babel-fish) ____)
+
+      (assert-true (equalp babel-fish expected))))
+
+
+(define-test test-hash-key-membership
+    "hash tables use multiple value return to tell you if the key exists"
+    (let ((prev-pres (make-hash-table :test #'equal))
+          (value-and-exists nil))
+      (setf (gethash "Obama" prev-pres) "Bush")
+      (setf (gethash "Lincoln" prev-pres) "Buchanan")
+      (setf (gethash "Washington" prev-pres) nil)
+
+      (setf value-and-exists (multiple-value-list (gethash "Obama" prev-pres)))
+      (assert-equal value-and-exists '("Bush" t))
+      (setf value-and-exists (multiple-value-list (gethash "Lincoln" prev-pres)))
+      (assert-equal value-and-exists ____)
+      (setf value-and-exists (multiple-value-list (gethash "Washington" prev-pres)))
+      (assert-equal value-and-exists ____)
+      (setf value-and-exists (multiple-value-list (gethash "Franklin" prev-pres)))
+      (assert-equal value-and-exists ____)))
+
+
+(define-test test-make-your-own-hash-table
+    "make a hash table that meets the following conditions"
+  (let ((colors (make-hash-table))
+        (values (make-hash-table)))
+
+    (assert-equal (hash-table-count colors) 4)
+    (setf values (list (gethash "blue" colors)
+                       (gethash "green" colors)
+                       (gethash "red" colors)))
+    (assert-equal values '((0 0 1) (0 1 0) (1 0 0)))))

koans/iteration.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+;; There are many options for iteration in lisp.
+;; This set of koans will introduce a few of the most common ones
+
+
+;; Dolist evaluates a form for every element om a list.
+
+(defvar some-primes '(10301 11311 19991 999565999))
+
+(define-test test-dolist
+    "'dolist' iterates over values in a list, binding each value to a lexical
+      variable in turn"
+  (let ((how-many-in-list 0)
+        (biggest-in-list (first some-primes)))
+    "this dolist loops over the some-primes, defined above"
+    (dolist (one-prime some-primes)
+      (if (> one-prime biggest-in-list)
+          (setf biggest-in-list one-prime))
+      (incf how-many-in-list))
+    (assert-equal ___ how-many-in-list)
+    (assert-equal ___ biggest-in-list))
+  (let ((sum 0))
+    "write your own do-list here to calculate the sum of some-primes"
+    "you may be interested in investigating the 'incf' function"
+    ;(dolist ... )
+    (assert-equal 999607602 sum)))
+
+
+(define-test test-dolist-with-return
+    "Dolist can accept a return variable, which will be the return value
+     upon completion of the iteration."
+    (let ((my-list '(1 2 3 4))
+          (my-return))
+      (dolist (x my-list my-return)
+        (push (* x x) my-return))
+      (assert-equal ____ my-return)))
+
+
+(define-test test-dotimes
+    "'dotimes' iterates over the integers from 0 to (limit - 1),
+      binding them in order to your selected symbol."
+    (let ((out-list nil))
+      (dotimes (y 3) (push y out-list))
+      (assert-equal out-list ___)))
+
+
+(defvar *x* "global")
+(define-test test-dotimes-binding
+    "dotimes establishes a local lexical binding which may shadow
+     a global value."
+  (dotimes (*x* 4)
+    (true-or-false? ___ (equal "global" *x*)))
+  (true-or-false? ___ (equal "global" *x*)))
+
+
+(define-test test-loop-until-return
+    "Loop loops forever, unless some return condition is executed.
+     Note that the loop macro includes many additional options,
+     which will be covered in a future koan."
+    (let ((loop-counter 0))
+      (loop
+        (incf loop-counter)
+        (if (>= loop-counter 100) (return loop-counter)))
+      (assert-equal ___ loop-counter)))
+
+
+(define-test test-mapcar
+    "mapcar takes a list an a function.  It returns a new list
+     with the function applied to each element of the input"
+  (let ((mc-result (mapcar #'evenp '(1 2 3 4 5))))
+    (assert-equal mc-result ____)))
+
+
+;; ----
+
+
+(defun vowelp (c)
+  "returns true iff c is a vowel"
+  (find c "AEIOUaeiou"))
+
+(defun vowels-to-xs (my-string)
+  "converts all vowels in a string to the character 'x'"
+  (coerce
+   (loop for c across my-string
+         with new-c
+         do (setf new-c (if (vowelp c) #\x c))
+         collect new-c)
+   'string))
+
+(define-test test-mapcar-with-defun
+  "mapcar is a convenient way to apply a function to a collection"
+  (assert-equal (vowels-to-xs "Astronomy") "xstrxnxmy")
+  (let* ((subjects '("Astronomy" "Biology" "Chemistry" "Linguistics"))
+         (mc-result (mapcar #'vowels-to-xs subjects)))
+    (assert-equal mc-result ____)))
+
+
+;; ----
+
+(define-test test-mapcar-with-lambda
+    (let ((mc-result (mapcar #'(lambda (x) (mod x 10)) '(21 152 403 14))))
+      (assert-equal mc-result ____)))

koans/lists.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+;; based on python koans 'about_lists.py'
+;; based also on "Lisp 3rd addition" ch. 17. "List storage, surgery and reclamation"
+
+
+(define-test test-creating-lists
+    "lists can be created using the quote form, or the 'list' function"
+  (let ((fruits nil)
+        (some-evens nil))
+    (setf fruits '(orange pomello clementine))
+    (setf some-evens (list (* 2 1) (* 2 2) (* 2 3)))
+    (assert-equal fruits ___)
+    (assert-equal ___ (length fruits))))
+
+
+(define-test test-list-cons
+    "cons CONStructs new lists, by prefixing some list with
+     a new element like (cons new-element some-list)"
+    (let ((nums nil))
+      (setf nums (cons :one nums))
+      (assert-equal '(:one) nums)
+
+      (setf nums (cons :two nums))
+      (assert-equal ___ nums)
+
+      "lists can contain anything, even mixtures of different things"
+      (setf nums (cons 333 nums))
+      (assert-equal ___ nums)
+
+      "lists can of course contain lists"
+      (setf nums (cons '("the" "rest") nums))
+      (assert-equal ___ nums)))
+
+
+(define-test test-push-pop
+    (let ((stack '(10 20 30 40))
+          (firstval nil))
+      "push adds an element to the beginning of a list referred to by some symbol"
+      (push "last" stack)
+      (assert-equal '("last" 10 20 30 40) stack)
+
+       "pop is the opposite of push.
+       It removes and returns the first element of a list"
+      (setf firstval (pop stack))
+      (assert-equal "last" firstval)
+      (assert-equal '(10 20 30 40) stack)
+
+      (setf firstval (pop stack))
+      (assert-equal ___ firstval)
+      (assert-equal ___ stack)))
+
+
+(define-test test-append
+    "append attatches one list ot the end of another."
+  (assert-equal '(:a :b :c) (append '(:a :b) '(:c)))
+
+  (let ((abc '(:a :b :c))
+        (xyz '(:x :y :z))
+        (abcxyz nil))
+    (setf abcxyz (append abc xyz))
+    (assert-equal ___ abc)
+    (assert-equal ___ xyz)
+    (assert-equal ___ abcxyz)))
+
+
+(define-test test-accessing-list-elements
+    (let ((noms '("peanut" "butter" "and" "jelly")))
+      (assert-equal "peanut" (first noms))
+      (assert-equal ___ (second noms))
+      (assert-equal ___ (fourth noms))
+      "last returns a singleton list of the final element"
+      (assert-equal ___ (last noms))
+      (assert-equal "butter" (nth 1 noms)) ; k 1
+      (assert-equal ___ (nth 0 noms))
+      (assert-equal ___ (nth 2 noms))
+      "'elt' is similar to 'nth', with the arguments reversed"
+      (assert-equal ___ (elt noms 2))))
+
+
+(define-test test-slicing-lists
+    (let ((noms '("peanut" "butter" "and" "jelly")))
+      (assert-equal ___ (subseq noms 0 1))
+      (assert-equal ___ (subseq noms 0 2))
+      (assert-equal ___ (subseq noms 2 2))
+      (assert-equal ___ (subseq noms 2))))
+
+
+(define-test test-list-breakdown
+    "car (aka. 'first') returns the first value in a list"
+  (assert-equal ___ (car '(1 2 3)))
+  (assert-equal ___ (car nil))
+    "cdr (aka. 'rest') refers to the remainder of the list,
+     after the first element"
+  (assert-equal ___ (cdr '(1 2 3)))
+  (assert-equal ___ (cdr nil)))

koans/loops.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+;; see http://www.gigamonkeys.com/book/loop-for-black-belts.html
+;; "Loop for blackbelts" for more on the loop macro.
+
+(define-test test-basic-loop
+    (let* ((letters '(:a :b :c :d))
+           (loop-result
+             (loop for letter in letters
+                   collect letter)))
+      (assert-equal loop-result ____)))
+
+
+(define-test test-compound-loop
+    (let* ((letters '(:a :b :c :d))
+           (loop-result
+             (loop for letter in letters
+                   for i from 1 to 1000
+                   collect (list i letter))))
+      (assert-equal loop-result ____)))
+
+
+(define-test test-counting-loop-skip-by-syntax
+   "with multiple 'for' clauses, loop ends when the first is exhausted"
+    (let* ((letters '(:a :b :c :d))
+           (loop-result
+             (loop for letter in letters
+                   for i from 0 to 1000 by 5
+                   collect (list i letter))))
+      (assert-equal loop-result ____ )))
+
+
+(define-test test-counting-backwards
+    (let ((loop-result
+             (loop for i from 10 downto -10 by 5
+                   collect i )))
+      (assert-equal loop-result ____ )))
+
+
+(define-test test-loop-in-vs-loop-on
+    (let* ((letters '(:a :b :c))
+           (loop-result-in
+            (loop for letter in letters collect letter))
+           (loop-result-on
+            (loop for letter on letters collect letter)))
+      (assert-equal loop-result-in ____)
+      (assert-equal loop-result-on ____ )))
+
+
+(define-test test-loop-in-skip-by
+    (let* ((letters '(:a :b :c :d :e :f))
+           (loop-result-in
+            (loop for letter in letters collect letter))
+           (loop-result-in-cdr
+            (loop for letter in letters by #'cdr collect letter))
+           (loop-result-in-cddr
+            (loop for letter in letters by #'cddr collect letter))
+           (loop-result-in-cdddr
+            (loop for letter in letters by #'cdddr collect letter)))
+      (assert-equal loop-result-in ____)
+      (assert-equal loop-result-in-cdr ____)
+      (assert-equal loop-result-in-cddr ____)
+      (assert-equal loop-result-in-cdddr ____)))
+
+
+(define-test test-loop-across-vector
+    (let* ((my-vector (make-array '(5) :initial-contents '(0 1 2 3 4)))
+           (loop-result
+            (loop for val across my-vector collect val)))
+      (assert-equal ____ loop-result)))
+
+
+(define-test test-loop-across-2d-array
+    (let* ((my-array (make-array '(3 3) :initial-contents '((0 1 2) (3 4 5) (6 7 8))))
+           (loop-result
+            (loop for i from 0 below (array-total-size my-array) collect (row-major-aref my-array i))))
+      (assert-equal loop-result ____ )))
+
+
+(define-test test-loop-across-2d-array-respecting-shape
+    (let* ((my-array (make-array '(3 2) :initial-contents '((0 1) (2 3) (4 5))))
+           (loop-result
+            (loop for i from 0 below (array-dimension my-array 0) collect
+              (loop for j from 0 below (array-dimension my-array 1) collect
+                (expt (aref my-array i j) 2)))))
+      (assert-equal loop-result ____ )))
+
+
+(defvar books-to-heros)
+(setf books-to-heros (make-hash-table :test 'equal))
+(setf (gethash "The Hobbit" books-to-heros) "Bilbo")
+(setf (gethash "Where The Wild Things Are" books-to-heros) "Max")
+(setf (gethash "The Wizard Of Oz" books-to-heros) "Dorothy")
+(setf (gethash "The Great Gatsby" books-to-heros) "James Gatz")
+
+
+(define-test test-loop-over-hash-tables
+    (let* ((pairs-in-table
+            (loop for k being the hash-keys in books-to-heros
+                  using (hash-value v)
+                  collect (list k v))))
+      (assert-equal ____ (length pairs-in-table))
+      (true-or-false? ____ (find '("The Hobbit" "Bilbo") pairs-in-table :test #'equal))))
+
+
+(define-test test-value-accumulation-forms
+    (let ((loop-1
+           (loop for x in '(1 2 4 8 16)
+                 collect x into collected
+                   count x into counted
+                 sum x into summed
+                 maximize x into maximized
+                 minimize x into minimized
+                 finally (return (list collected counted summed maximized minimized)))))
+      (destructuring-bind (col count sum max min) loop-1
+        (assert-equal col ____)
+        (assert-equal count ____)
+        (assert-equal sum ____)
+        (assert-equal max ____)
+        (assert-equal min ____))))
+
+
+(define-test test-destructuring-bind
+    (let* ((count 0)
+           (result (loop for (a b) in '((1 9) (2 8) (3 7) (4 6))
+                        do (setf count (+ 1 count))
+                         collect (+ a b))))
+      (assert-equal ____ count)
+      (assert-equal ____ result)))
+
+
+(define-test test-conditional-execution
+    (let ((loop-return
+           (loop for x in '(1 1 2 3 5 8 13)
+                 when (evenp x) sum x)))
+      (assert-equal loop-return ____)))
+
+
+(defun greater-than-10-p (x)
+  (> x 10))
+
+(define-test test-conditional-with-defun
+    (let ((loop-return
+           (loop for x in '(1 1 2 3 5 8 13)
+                 when (greater-than-10-p x) sum x)))
+      (assert-equal loop-return ____)))
+
+
+(define-test test-conditional-with-lambda
+    (let ((loop-return
+           (loop for x in '(1 1 2 3 5 8 13)
+                 when ((lambda (z) (equal 1 (mod z 3))) x) sum x)))
+      (assert-equal loop-return ____)))

koans/macros.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+;; A lisp macro is like a function which takes an input lisp form
+;; and produces a new output lisp form.  Calling the macro
+;; first produces new form, and then evaluates it in the context
+;; of the macro call.  The first phase, the creation of the new
+;; macro form, is called 'macro expansion'.
+
+
+
+(defmacro repeat-2 (f) (list 'progn f f))
+
+(define-test test-macro-expands
+    "assert-expands checks the expanded macro form against expectation."
+  (assert-expands
+   '(progn (do-something arg1 arg2) (do-something arg1 arg2))
+   (repeat-2 (do-something arg1 arg2)))
+
+  (assert-expands
+   ____
+   (repeat-2 (setf x (+ 1 x)))))
+
+
+;; ----
+
+
+(define-test test-backtick-form
+    "backtick (`) form is much like single-quote (') form, except that subforms
+     preceded by a comma (,) are evaluated, rather then left as literals"
+  (let ((num 5)
+        (word 'dolphin))
+    (true-or-false? ___  (equal '(1 3 5) `(1 3 5)))
+    (true-or-false? ___  (equal '(1 3 5) `(1 3 num)))
+    (assert-equal ____ `(1 3 ,num))
+    (assert-equal ____ `(word ,word ,word word))))
+
+
+(define-test test-at-form
+    "The at form, (@) in the backtick context splices a list variables into
+     the form."
+    (let ((axis '(x y z)))
+      (assert-equal '(x y z) axis)
+      (assert-equal '(the axis are (x y z)) `(the axis are ,axis))
+      (assert-equal '(the axis are x y z) `(the axis are ,@axis)))
+    (let ((coordinates '((43.15 77.6) (42.36 71.06))))
+      (assert-equal ____
+        `(the coordinates are ,coordinates))
+      (assert-equal ____
+        `(the coordinates are ,@coordinates))))
+
+
+;; ---- On Gensym: based on ideas from common lisp cookbook
+
+;; sets sym1 and sym2 to val
+(defmacro double-setf-BAD (sym1 sym2 val)
+  `(progn (setf ,sym1 ,val) (setf ,sym2 ,val)))
+
+(define-test test-no-gensym
+    "macro expansions may introduce difficult to see
+     interactions"
+  (let ((x 0)
+        (y 0))
+    (double-setf-BAD x y 10)
+    (assert-equal x 10)
+    (assert-equal y 10))
+
+  (let ((x 0)
+        (y 0))
+    (double-setf-BAD x y (+ x 100))
+    (assert-equal x ____)
+    (assert-equal y ____)))
+
+;; sets sym1 and sym2 to val
+(defmacro double-setf-SAFER (sym1 sym2 val)
+  (let ((new-fresh-symbol (gensym)))
+    `(let ((,new-fresh-symbol ,val))
+       (progn (setf ,sym1 ,new-fresh-symbol) (setf ,sym2 ,new-fresh-symbol)))))
+
+(define-test test-with-gensym
+    "gensym creates a new symbol."
+  (let ((x 0)
+        (y 0))
+    (double-setf-SAFER x y 10)
+    (assert-equal x 10)
+    (assert-equal y 10))
+
+  (let ((x 0)
+        (y 0))
+    (double-setf-SAFER x y (+ x 100))
+    (assert-equal x ____)
+    (assert-equal y ____)))
+
+
+;; ----
+
+(defvar *log* nil)
+
+(defmacro log-form (&body body)
+  "records the body form to the list *log* and then evalues the body normally"
+  `(let ((retval ,@body))
+     (push ',@body *log*)
+     retval))
+
+(define-test test-basic-log-form
+  "illustrates how the basic log-form macro above works"
+  (assert-equal 1978 (* 2 23 43))
+  (assert-equal nil *log*)
+  "log-form does not interfere with the usual return value"
+  (assert-equal 1978 (log-form (* 2 23 43)))
+  "log-form records the code which it has been passed"
+  (assert-equal ___ (length *log*))
+  (assert-equal ___ (first *log*))
+  "macros evaluating to more macros is ok, if confusing"
+  (assert-equal 35 (log-form (log-form (- 2013 1978))))
+  (assert-equal 3 (length *log*))
+  (assert-equal '(log-form (- 2013 1978)) (first *log*))
+  (assert-equal '(- 2013 1978) (second *log*)))
+
+;; Now you must write a more advanced log-form, that also records the value
+;; returned by the form
+
+(defvar *log-with-value* nil)
+
+;; you must write this macro
+(defmacro log-form-with-value (&body body)
+  "records the body form, and the form's return value
+   to the list *log-with-value* and then evalues the body normally"
+  `(let ((logform nil)
+         (retval ,@body))
+
+     ;; YOUR MACRO COMPLETION CODE GOES HERE.
+
+     retval))
+
+
+
+(define-test test-log-form-and-value
+    "log should start out empty"
+  (assert-equal nil *log-with-value*)
+  "log-form-with-value does not interfere with the usual return value"
+  (assert-equal 1978 (log-form-with-value (* 2 23 43)))
+  "log-form records the code which it has been passed"
+  (assert-equal 1 (length *log-with-value*))
+  (assert-equal '(:form (* 2 23 43) :value 1978) (first *log-with-value*))
+  "macros evaluating to more macros is ok, if confusing"
+  (assert-equal 35 (log-form-with-value (log-form-with-value (- 2013 1978))))
+  (assert-equal 3 (length *log-with-value*))
+  (assert-equal '(:form (log-form-with-value (- 2013 1978)) :value 35) (first *log-with-value*))
+  (assert-equal '(:form (- 2013 1978) :value 35) (second *log-with-value*)))

koans/mapcar-and-reduce.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+(define-test test-mapcar-basics
+    "We can apply a function to each member
+     of a list using mapcar."
+  (defun times-two (x) (* x 2))
+  (assert-equal ____ (mapcar #'times-two '(1 2 3)))
+  (assert-equal ____ (mapcar #'first '((3 2 1) 
+                                      ("little" "small" "tiny") 
+                                      ("pigs" "hogs" "swine")))))
+
+
+(define-test test-mapcar-multiple-lists
+    "The mapcar function can be applied to
+     more than one list. It applies a function
+     to successive elements of the lists."
+  (assert-equal ____ (mapcar #'* '(1 2 3) '(4 5 6)))
+  (assert-equal ____ (mapcar #'list '("lisp" "are") '("koans" "fun"))))
+
+
+(define-test test-transpose-using-mapcar
+    "Replace WRONG-FUNCTION with the correct function (don't forget
+     the #') to take the 'transpose'."
+  (defun WRONG-FUNCTION-1 (&rest rest) '())
+  (defun transpose (L) (apply #'mapcar (cons #'WRONG-FUNCTION-1 L)))
+    (assert-equal '((1 4 7)
+                  (2 5 8) 
+                  (3 6 9)) 
+                (transpose '((1 2 3) 
+                             (4 5 6) 
+                             (7 8 9))))
+  (assert-equal '(("these" "pretzels" "are")
+                  ("making" "me" "thirsty"))
+                (transpose '(("these" "making")
+                             ("pretzels" "me")
+                            ("are" "thirsty")))))
+
+
+(define-test test-reduce-basics
+    "The reduce function applies uses a supplied
+     binary function to combine the elements of a
+     list from left to right."
+  (assert-equal ___  (reduce #'+ '(1 2 3 4)))
+  (assert-equal ___ (reduce #'expt '(2 3 2))))
+
+
+(define-test test-reduce-right-to-left
+    "The keyword :from-end allows us to apply
+     reduce from right to left."
+  (assert-equal ___ (reduce #'+ '(1 2 3 4) :from-end t))
+  (assert-equal ___ (reduce #'expt '(2 3 2) :from-end t)))
+
+
+(define-test test-reduce-with-initial-value
+    "We can supply an initial value to reduce."
+  (assert-equal ___ (reduce #'expt '(10 21 34 43) :initial-value 1))
+  (assert-equal ___ (reduce #'expt '(10 21 34 43) :initial-value 0)))
+
+
+(defun WRONG-FUNCTION-2 (a b) (a))
+(defun WRONG-FUNCTION-3 (a b) (a))
+
+(define-test test-mapcar-and-reduce
+    "mapcar and reduce are a powerful combination.
+     insert the correct function names, instead of INCORRECT-FUNCTION-X
+     to define an inner product."
+  (defun inner (x y) 
+    (reduce #'WRONG-FUNCTION-2 (mapcar #'WRONG-FUNCTION-3 x y)))
+  (assert-equal 32 (inner '(1 2 3) '(4 5 6)))
+  (assert-equal 310 (inner '(10 20 30) '(4 3 7))))

koans/multiple-values.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+
+"In lisp, it is possible for a function to return more than one value.
+This is distinct from returning a list or structure of values."
+
+(define-test test-floor-returns-multiple-values
+    (let ((x)
+          (y))
+      (setf x (floor 1.5))
+      (assert-equal x 1)
+      (setf x (multiple-value-list (floor 3/2)))
+      (assert-equal x '(1 1/2)))
+  (assert-equal (multiple-value-list (floor 99/4)) ____))
+
+(defun next-fib (a b)
+  (values b (+ a b)))
+
+(define-test test-multi-value-bind
+    (let ((x)
+          (y))
+      (setf x (next-fib 2 3))
+      (assert-equal x ___)
+      (setf x (multiple-value-list (next-fib 2 3)))
+      (assert-equal x ___)
+      "multiple value bind binds the variables in the first form
+       to the outputs of the second form.  And then returns the output
+       of the third form using those bindings"
+      (setf y (multiple-value-bind (b c) (next-fib 3 5) (* b c)))
+      (assert-equal y ___)
+      "multiple-value-setq is like setf, but can set multiple variables"
+      (multiple-value-setq (x y) (values :v1 :v2))
+      (assert-equal (list x y) '(:v1 :v2))
+      (multiple-value-setq (x y) (next-fib 5 8))
+      (assert-equal (list x y) ____)))

koans/nil-false-empty.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+(define-test test-t-and-nil-are-opposites
+    "not is a function which returns the boolean opposite of its argument"
+   (true-or-false? ___ (not nil))
+   (true-or-false? ___ (not t)))
+
+
+(define-test test-nil-and-empty-list-are-the-same-thing
+  (true-or-false? ___ ())
+  (true-or-false? ___ (not ())))
+
+
+(define-test test-lots-of-things-are-true
+   " every value, other than nil, is boolean true"
+   (true-or-false? ___ 5)
+   (true-or-false? ___ (not 5))
+   (true-or-false? ___ "A String")
+   "only nil is nil.  Everything else is effectively true."
+   "the empty string"
+   (true-or-false? ___ "")
+   "a list containing a nil"
+   (true-or-false? ___ '(nil))
+   "an array with no elements"
+   (true-or-false? ___ (make-array '(0)))
+   "the number zero"
+   (true-or-false? ___ 0))
+
+
+(define-test test-and
+   "and can take multiple arguments"
+   (true-or-false? ___ (and t t t t t))
+   (true-or-false? ___ (and t t nil t t))
+   "if no nils, and returns the last value"
+   (assert-equal ___ (and t t t t t 5)))
+
+
+(define-test test-or
+   "or can also take multiple arguments"
+   (true-or-false? ____  (or nil nil nil t nil))
+   "or returns the first non nil value, or nil if there are none."
+   (assert-equal ____ (or nil nil nil))
+   (assert-equal ____ (or 1 2 3 4 5)))

koans/scope-and-extent.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+(defun shadow-z (z)
+;; reuses the symbol name z to build a return value
+;; returns a list like (value-of-z, 2) 
+  (cons z
+        (cons (let ((z 2)) z)
+              nil)))
+
+(define-test test-shadowing-a-variable
+  (assert-equal ___ (shadow-z 1)))
+
+
+(defun code-block-01 ()
+;; illustrates a basic property of code-blocks
+  (block here
+    (return-from here 4)
+    5))
+
+(defun code-block-02 ()
+  (block outer
+    (block inner
+      (return-from outer 'space)
+      (return-from inner 'tube))
+    (return-from outer 'valve)))
+
+(define-test test-code-block-01
+  (assert-equal ___ (code-block-01)))
+
+(define-test test-code-block-02
+  (assert-equal ___ (code-block-02)))
+
+
+;; About closures and the distinction of lexical and dynamic bindings
+
+;; this recipe from stackoverflow
+;; http://stackoverflow.com/questions/463463/dynamic-and-lexical-variables-in-common-lisp
+; (print "no special x: a typical closure.")
+
+;; bind f to a function which depends on a local variable x
+;; then invoke f to see which value of x is returned.
+
+(define-test test-lexical-bindings-may-be-shadowed
+  (assert-eq ___ (let ((f (let ((x 10))
+                 (lambda () x))))  ; <-- x bound lexically
+    (let ((x 20))          ; form 2
+      (funcall f)))))
+
+
+(define-test test-special-bindings-look-back-on-execution-path
+  (assert-eq ___ (let ((f (let ((x 10))
+             (declare (special x))
+             (lambda () x))))      ; <-- x bound dynamically
+    (let ((x 20))          ; form 2
+      (declare (special x))
+    (funcall f)))))

koans/scoring-project.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+;;;;;;;;;;;;;;
+;; GREED !! ;;
+;;;;;;;;;;;;;;
+
+
+;; Modified from Ruby Koans: about_scoring_project.rb
+
+; *Greed* is a dice game where you roll up to five dice to accumulate
+; points.  The following "score" function will be used to calculate the
+; score of a single roll of the dice.
+;
+; A greed roll is scored as follows:
+;
+; * A set of three ones is 1000 points
+;
+; * A set of three numbers (other than ones) is worth 100 times the
+;   number. (e.g. three fives is 500 points).
+;
+; * A one (that is not part of a set of three) is worth 100 points.
+;
+; * A five (that is not part of a set of three) is worth 50 points.
+;
+; * Everything else is worth 0 points.
+;
+;
+; Examples:
+;
+; score([1,1,1,5,1]) => 1150 points
+; score([2,3,4,6,2]) => 0 points
+; score([3,4,5,3,3]) => 350 points
+; score([1,5,1,2,4]) => 250 points
+;
+; More scoring examples are given in the tests below:
+;
+; Your goal is to write the score method.
+
+(defun score (dice)
+  ; You need to write this method
+)
+
+(define-test test-score-of-an-empty-list-is-zero
+    (assert-equal 0 (score nil)))
+
+(define-test test-score-of-a-single-roll-of-5-is-50
+    (assert-equal 50 (score '(5))))
+
+
+(define-test test-score-of-a-single-roll-of-1-is-100
+    (assert-equal 100 (score '(1))))
+
+(define-test test-score-of-multiple-1s-and-5s-is-the-sum-of-individual-scores
+    (assert-equal 300 (score '(1 5 5 1))))
+
+(define-test test-score-of-single-2s-3s-4s-and-6s-are-zero
+    (assert-equal 0 (score '(2 3 4 6))))
+
+
+(define-test test-score-of-a-triple-1-is-1000
+    (assert-equal 1000  (score '(1 1 1))))
+
+(define-test test-score-of-other-triples-is-100x
+    (assert-equal 200  (score '(2 2 2)))
+    (assert-equal 300  (score '(3 3 3)))
+    (assert-equal 400  (score '(4 4 4)))
+    (assert-equal 500  (score '(5 5 5)))
+    (assert-equal 600  (score '(6 6 6))))
+
+(define-test test-score-of-mixed-is-sum
+    (assert-equal 250  (score '(2 5 2 2 3)))
+    (assert-equal 550  (score '(5 5 5 5))))

koans/special-forms.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+; Special forms are evaluatable lisp forms (lists) which are
+; neither functions nor macros.  Here is an introduction to a
+; few of them.
+
+; based on http://psg.com/~dlamkins/sl/chapter03-03.html
+
+(defvar my-name)
+(defvar my-clones-name)
+(defvar a)
+(defvar b)
+(defvar c 0)
+
+(define-test test-setf
+    "setf is used to assign values to symbols.  These symbols my refer to
+     variables with lexical or dynamic scope."
+  (setf my-name "David")
+  (assert-equal my-name ____)
+  " In SBCL, if the symbol isn't defined as a variable, via a top-level defvar
+  or let statement, the setf call may result in a warning."
+  (setf my-clones-name my-name)
+  (assert-equal "David" ____)
+  (setf a 5)
+  (setf b 10)
+  (setf c ___)
+  (assert-equal 50 c))
+
+
+(define-test test-let
+    "The let form establishes a lexical extent, within which explicit symbols
+     may be bound to values.  The binding only extends over the extent of the
+     lexical form.  After which, the previous value, if it exists, is visible again."
+  (setf a 10)
+  (setf b 20)
+  (assert-equal a ___)
+  (assert-equal b ___)
+  (let ((a 1111)
+        (b 2222))
+    (assert-equal a ___)
+    (assert-equal b ___))
+  (assert-equal a ___)
+  (assert-equal b ___))
+
+
+(define-test test-let-default-value
+    "let vars have a default value"
+    (let ((x))
+      (assert-equal ___ x)))
+
+(define-test test-let-bindings-are-parallel
+    "When defining the bindings in the let form, later bindings may not depend
+     on earlier ones"
+  (setf a 100)
+  (let ((a 5)
+        (b (* 10 a)))
+    (assert-equal b ___)))
+
+(define-test test-let*-bindings-are-series
+    "let* is like let, but successive bindings may use values of previous ones"
+  (setf a 100)
+  (let* ((a 5)
+         (b (* 10 a)))
+    (assert-equal b ___))
+  (assert-equal a ___))
+
+
+(define-test write-your-own-let-statement
+    "fix the let statement to get the tests to pass"
+  (setf a 100)
+  (setf b 23)
+  (setf c 456)
+  (let ((a 0)
+        (b __)
+        (c __))
+    (assert-equal a 100)
+    (assert-equal b 200)
+    (assert-equal c "Jellyfish"))
+  (let* ((a 0))
+    (assert-equal a 121)
+    (assert-equal b 200)
+    (assert-equal c (+ a (/ b a)))))
+
+
+(define-test test-cond
+    "the cond form is like the c switch statement"
+  (setf a 4)
+  (setf c
+        (cond ((> a 0) :positive)
+              ((< a 0) :negative)
+              (t :zero)))
+  (assert-equal ____ c))
+
+
+(defun cartoon-dads (input)
+  " you should be able to complete this cond statement"
+  (cond ((equal input :this-one-doesnt-happen) :fancy-cat)
+        (t :unknown)))
+
+(define-test test-your-own-cond-statement
+    "fix this by completing the 'cartoon-dads' function above"
+  (assert-equal (cartoon-dads :bart) :homer)
+  (assert-equal (cartoon-dads :stewie) :peter)
+  (assert-equal (cartoon-dads :stan) :randy)
+  (assert-equal (cartoon-dads :space-ghost) :unknown))

koans/strings.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+(define-test test-double-quoted-strings-are-strings
+    (let ((my-string "do or do not"))
+      (true-or-false? ___ (typep my-string 'string))
+      "strings are the same thing as vectors of characters"
+      (true-or-false? ___ (typep my-string 'array))
+      (assert-equal (aref "meat" 2) (aref "fiesta" 5))
+      "strings are not integers :p"
+      (true-or-false? ___ (typep my-string 'integer))))
+
+
+(define-test test-multi-line-strings-are-strings
+    (let ((my-string "this is
+                      a multi
+                      line string"))
+      (true-or-false? ___ (typep my-string 'string))))
+
+
+(define-test test-escape-quotes
+    (let ((my-string "this string has one of these \" in it"))
+      (true-or-false? ___ (typep my-string 'string))))
+
+
+; This test from common lisp cookbook
+(define-test test-substrings
+    "since strings are sequences, you may use subseq"
+  (let ((my-string "Groucho Marx"))
+    (assert-equal "Marx" (subseq my-string 8))
+    (assert-equal (subseq my-string 0 7) ____)
+    (assert-equal (subseq my-string 1 5) ____)))
+
+(define-test test-accessing-individual-characters
+  "char literals look like this"
+  (true-or-false? ___ (typep #\a 'character))
+  (true-or-false? ___ (typep "A" 'character))
+  (true-or-false? ___ (typep #\a 'string))
+  "char is used to access individual characters"
+  (let ((my-string "Cookie Monster"))
+    (assert-equal (char my-string 0) #\C)
+    (assert-equal (char my-string 3) #\k)
+    (assert-equal (char my-string 7) ___)))
+
+
+(define-test test-concatenating-strings
+    "concatenating strings in lisp is a little cumbersome"
+  (let ((a "this")
+        (b "is")
+        (c "unwieldly"))
+    (assert-equal ___ (concatenate 'string a " " b " " c))))
+
+
+(define-test test-searching-for-characters
+    "you can use position to detect characters in strings
+     (or elements of sequences)"
+  (assert-equal ___ (position #\b "abc"))
+  (assert-equal ___ (position #\c "abc"))
+  (assert-equal ___ (find #\d "abc")))
+
+
+(define-test test-finding-substrings
+    "search finds subsequences"
+  (let ((title "A supposedly fun thing I'll never do again"))
+    (assert-equal 2 (search "supposedly" title))
+    (assert-equal 12 (search "CHANGETHISWORD" title))))
+

koans/structures.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+;; Lisp structures encapsulate data which belongs together.  They are
+;; a template of sorts, providing a way to generate multiple instances of
+;; uniformly organized information
+;;
+;; Defining a struct also interns accessor functions to get and set the fields
+;; of the structure.
+
+
+;; Define a new struct with the defstruct form.  The following call creates a
+;; new structure type named basketball-player, with slots named:
+;; 'name', 'team', and number.
+(defstruct basketball-player name team number)
+
+(define-test test-make-struct
+    ;; Create a basketball structure instance, and then read out the values.
+  (let ((player-1 (make-basketball-player
+                   :name "larry" :team :celtics :number 33)))
+    (assert-equal "larry" (basketball-player-name player-1))
+    (assert-equal ___ (basketball-player-team player-1))
+    (assert-equal ___ (basketball-player-number player-1))
+    (assert-equal 'basketball-player (type-of player-1))
+    (setf (basketball-player-team player-1) :RETIRED)
+    (assert-equal ___ (basketball-player-team player-1))))
+
+
+;; Struct fields can have default values
+;; fields without explicit defaults default to nil.
+
+(defstruct baseball-player name (position :outfield) (team :red-sox))
+
+(define-test test-struct-defaults
+    (let ((player-2 (make-baseball-player)))
+      (assert-equal ___ (baseball-player-position player-2))
+      (assert-equal ___ (baseball-player-team player-2))
+      (assert-equal ___ (baseball-player-name player-2))))
+
+
+;; The accessor names can get pretty long.  It's possible to specify
+;; a nickname to make code readable with the :conc-name option.
+
+(defstruct (american-football-player (:conc-name nfl-guy-)) name position team)
+
+(define-test test-abbreviated-struct-access
+    (let ((player-3 (make-american-football-player
+                     :name "Drew Brees" :position :QB :team "Saints")))
+      (assert-equal ___ (nfl-guy-position player-3))))
+
+
+;; Structs can be defined as EXTENSIONS to previous structures.
+;; This form of inheritance allows composition of objects.
+
+(defstruct (nba-contract (:include basketball-player)) salary start-year end-year)
+
+(define-test test-structure-extension
+    (let ((contract-1 (make-nba-contract
+                       :salary 136000000
+                       :start-year 2004
+                       :end-year 2011
+                       :name "Kobe Bryant"
+                       :team :LAKERS
+                       :number 24)))
+      (assert-equal ___ (nba-contract-start-year contract-1))
+      (assert-equal ___ (type-of contract-1))
+      ;; do inherited structures follow the rules of type hierarchy?
+      (true-or-false? ___ (typep contract-1 'BASKETBALL-PLAYER))
+      ;; can you access structure fields with the inherited accessors?
+      (assert-equal ___ (nba-contract-team contract-1))
+      (assert-equal ___ (basketball-player-team contract-1))))
+
+
+;; Copying of structs is handled with the copy-{name} form.  Note that
+;; copying is shallow.
+
+(define-test test-structure-copying
+    (let ((manning-1 (make-american-football-player :name "Manning" :team '("Colts" "Broncos")))
+          (manning-2 (make-american-football-player :name "Manning" :team '("Colts" "Broncos"))))
+      ;; manning-1 and manning-2 are different objects
+      (true-or-false? ___ (eq manning-1 manning-2))
+      ;; but manning-1 and manning-2 contain the same information
+      ;; (note the equalp instead of eq
+      (true-or-false? ___ (equalp manning-1 manning-2))
+      ;; copied structs are much the same.
+      (true-or-false? ___ (equalp manning-1 (copy-american-football-player manning-1)))
+      (true-or-false? ___ (eq     manning-1 (copy-american-football-player manning-1)))
+      ;; note that the copying is shallow
+      (let ((shallow-copy (copy-american-football-player manning-1)))
+        (setf (car (nfl-guy-team manning-1)) "Giants")
+        (assert-equal ___ (car (nfl-guy-team manning-1)))
+        (assert-equal ___ (car (nfl-guy-team shallow-copy))))))

koans/threads.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+;; NOTE: This koan group uses language features specific to sbcl, that are 
+;; not part of the Common Lisp specification.  If you are not using sbcl, 
+;; feel free to skip this group by removing it from '.koans'
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Making threads with sb-thread:make-thread  ;;
+;; Joining threads with sb-thread:join-thread ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; sb-thread takes a -function- as a parameter.
+;; This function will be executed in a separate thread.
+
+;; Since the execution order of separate threads is not guaranteed,
+;; we must -join- the threads in order to make our assertions.
+
+(defvar *greeting* "no greeting")
+
+(defun sets-socal-greeting ()
+  (setf *greeting* "Sup, dudes"))
+
+(define-test test-hello-world-thread
+    "Create a thread which returns 'hello world', then ends.
+    using a lambda as the supplied function to execute."
+  (assert-equal *greeting* "no greeting")
+  (let ((greeting-thread
+         (sb-thread:make-thread
+          (lambda ()
+            (setf *greeting* "hello world")))))
+    (sb-thread:join-thread greeting-thread)
+    (assert-equal *greeting* "hello world")
+    (setf greeting-thread (sb-thread:make-thread #'sets-socal-greeting))
+    (sb-thread:join-thread greeting-thread)
+    (assert-equal *greeting* ____)))
+
+
+(define-test test-join-thread-return-value
+    "the return value of the thread is passed in sb-thread:join-thread"
+  (let ((my-thread (sb-thread:make-thread
+                    (lambda () (* 11 99)))))
+    (assert-equal ____ (sb-thread:join-thread my-thread))))
+
+
+(define-test test-threads-can-have-names
+    "Threads can have names.  Names can be useful in diagnosing problems
+     or reporting."
+  (let ((empty-plus-thread
+         (sb-thread:make-thread #'+
+                                :name "what is the sum of no things adding?")))
+    (assert-equal (sb-thread:thread-name empty-plus-thread)
+                  ____)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Sending arguments to the thread function: ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun returns-hello-name (name)
+  (format nil "Hello, ~a" name))
+
+(defun double-wrap-list (x y z)
+  (list (list x y z)))
+
+;; Create a thread which will print out "Hello -Name-" using
+;; the named write-hello-name function.   Arguments are handed
+;; to threads as a list, unless there is just a single argument
+;; then it does not need to be wrapped in a list.
+
+(define-test test-sending-arguments-to-thread
+    (assert-equal "Hello, Buster" 
+                  (sb-thread:join-thread
+                   (sb-thread:make-thread 'returns-hello-name
+                                          :arguments "Buster")))
+    (assert-equal ____
+                  (sb-thread:join-thread
+                   (sb-thread:make-thread 'double-wrap-list
+                                          :arguments '(3 4 5)))))
+
+
+;; ----
+
+(defvar *accum* 0)
+
+(defun accum-after-time (time arg1)
+    "sleeps for time seconds and then adds arg1 to *accum*"
+  (sleep time)
+  (incf *accum* arg1))
+
+(defvar *before-time-millisec* 0)
+(defvar *after-time-millisec* 0)
+
+;; cheap and dirty time measuring function
+(defun duration-ms ()
+  (- *after-time-millisec* *before-time-millisec*))
+
+(define-test test-run-in-series
+    "get internal real time returns a time stamp in milliseconds"
+  (setf *accum* 0)
+  (setf *before-time-millisec* (get-internal-real-time))
+  (accum-after-time 0.3 1)
+  (accum-after-time 0.2 2)
+  (accum-after-time 0.1 4)
+  (setf *after-time-millisec* (get-internal-real-time))
+  (true-or-false? ___ (> (duration-ms) 500))
+  (true-or-false? ___ (< (duration-ms) 700))
+  (assert-equal *accum* ___))
+
+(define-test test-run-in-parallel
+    "same program as above, executed in threads.  Sleeps are simultaneous"
+  (setf *accum* 0)
+  (setf *before-time-millisec* (get-internal-real-time))
+  (let ((thread-1 (sb-thread:make-thread 'accum-after-time :arguments '(0.3 1)))
+        (thread-2 (sb-thread:make-thread 'accum-after-time :arguments '(0.2 2)))
+        (thread-3 (sb-thread:make-thread 'accum-after-time :arguments '(0.1 4))))
+    (sb-thread:join-thread thread-1)
+    (sb-thread:join-thread thread-2)
+    (sb-thread:join-thread thread-3))
+  (setf *after-time-millisec* (get-internal-real-time))
+  (true-or-false? ___ (> (duration-ms) 200))
+  (true-or-false? ___  (< (duration-ms) 400))
+  (assert-equal *accum* ___))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; killing renegade threads            ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defun spawn-looping-thread (name)
+  "create a never-ending looping thread with a given name"
+  (sb-thread:make-thread (lambda () (loop)) :name name))
+
+(defvar *top-thread* sb-thread:*current-thread*)
+(defun main-thread-p (thread) (eq thread *top-thread*))
+
+(defun kill-thread-if-not-main (thread)
+" kills a given thread, unless the thread is the main thread.
+ returns nil if thread is main.
+ returns a 'terminated~' string otherwise"
+  (unless (main-thread-p thread)
+    (sb-thread:terminate-thread thread)
+    (concatenate 'string "terminated " (sb-thread:thread-name thread))))
+
+(defun kill-spawned-threads ()
+  "kill all lisp threads except the main thread."
+  (map 'list 'kill-thread-if-not-main (sb-thread:list-all-threads)))
+
+(defun spawn-three-loopers ()
+  "Spawn three run-aways."
+  (progn
+    (spawn-looping-thread "looper one")
+    (spawn-looping-thread "looper two")
+    (spawn-looping-thread "looper three")))
+
+(define-test test-counting-and-killing-threads
+    "list-all-threads makes a list of all running threads in this lisp.  The sleep
+     calls are necessary, as killed threads are not instantly removed from the
+     list of all running threads."
+  (assert-equal ___ (length (sb-thread:list-all-threads)))
+  (kill-thread-if-not-main (spawn-looping-thread "NEVER CATCH ME~!  NYA NYA!"))
+  (sleep 0.01)
+  (assert-equal ___ (length (sb-thread:list-all-threads)))
+  (spawn-three-loopers)
+  (assert-equal ___ (length (sb-thread:list-all-threads)))
+  (kill-spawned-threads)
+  (sleep 0.01)
+  (assert-equal ___ (length (sb-thread:list-all-threads))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; bindings are not inherited across threads ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar *v* 0)
+
+(defun returns-v ()
+  *v*)
+
+(define-test test-threads-dont-get-bindings
+    "bindings are not inherited across threads"
+  (let ((thread-ret-val (sb-thread:join-thread
+                         (sb-thread:make-thread 'returns-v))))
+    (assert-equal thread-ret-val ____))
+  (let ((*v* "LEXICAL BOUND VALUE"))
+    (assert-equal *v* ____)
+    (let ((thread-ret-val (sb-thread:join-thread
+                           (sb-thread:make-thread 'returns-v))))
+      (assert-equal thread-ret-val ____))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; global state (special vars) are ;;
+;; shared across threads           ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar *g* 0)
+
+(defun waits-and-increments-g (&optional (n 0.2))
+  "sets *g* to 1 + the value of *g* n seconds ago"
+  (let ((my-remembered-g *g*))
+    (sleep n)
+    (setq *g* (+ 1 my-remembered-g))))
+
+(define-test test-serial-wait-and-increment
+ "incrementing *g* three times and expecting
+  the final value to be three works."
+  (setf *g* 0)
+  (waits-and-increments-g)
+  (waits-and-increments-g)
+  (waits-and-increments-g)
+  (assert-equal *g* ___))
+
+
+(define-test test-parallel-wait-and-increment
+    (setf *g* 0)
+  (let ((thread-1 (sb-thread:make-thread 'waits-and-increments-g))
+        (thread-2 (sb-thread:make-thread 'waits-and-increments-g))
+        (thread-3 (sb-thread:make-thread 'waits-and-increments-g)))
+    (sb-thread:join-thread thread-1)
+    (sb-thread:join-thread thread-2)
+    (sb-thread:join-thread thread-3)
+    (assert-equal *g* ___)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Global state can be protected ;;
+;; with a mutex.                 ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(setf *g* 0)
+(defvar *gs-mutex* (sb-thread:make-mutex :name "g's lock"))
+
+(defun protected-increments-g (&optional (n 0.1))
+  "Surround all references to *g* within the with-mutex form."
+  (sb-thread:with-mutex (*gs-mutex*)
+    (let ((my-remembered-g *g*))
+      (sleep n)
+      (setq *g* (+ 1 my-remembered-g)))))
+
+(define-test test-parallel-wait-and-increment-with-mutex
+    (setf *g* 0)
+  (let ((thread-1 (sb-thread:make-thread 'protected-increments-g))
+        (thread-2 (sb-thread:make-thread 'protected-increments-g))
+        (thread-3 (sb-thread:make-thread 'protected-increments-g)))
+    (sb-thread:join-thread thread-1)
+    (sb-thread:join-thread thread-2)
+    (sb-thread:join-thread thread-3)
+    (assert-equal *g* ___)))
+
+;;;;;;;;;;;;;;;;
+;; Semaphores ;;
+;;;;;;;;;;;;;;;;
+
+;; Incrementing a semaphore is an atomic operation.
+(defvar *g-semaphore* (sb-thread:make-semaphore :name "g" :count 0))
+
+(defun semaphore-increments-g ()
+  (sb-thread:signal-semaphore *g-semaphore*))
+
+(define-test test-increment-semaphore
+    (assert-equal 0 (sb-thread:semaphore-count *g-semaphore*))
+  (sb-thread:join-thread (sb-thread:make-thread 'semaphore-increments-g :name "S incrementor 1"))
+  (sb-thread:join-thread (sb-thread:make-thread 'semaphore-increments-g :name "S incrementor 2"))
+  (sb-thread:join-thread (sb-thread:make-thread 'semaphore-increments-g :name "S incrementor 3"))
+  (assert-equal ___ (sb-thread:semaphore-count *g-semaphore*)))
+
+
+;; Semaphores can be used to manage resource allocation, and to trigger
+;; threads to run when the semaphore value is above zero.
+
+(defvar *apples* (sb-thread:make-semaphore :name "how many apples" :count 0))
+(defvar *orchard-log* (make-array 10))
+(defvar *next-log-idx* 0)
+(defvar *orchard-log-mutex* (sb-thread:make-mutex :name "orchard log mutex"))
+
+(defun add-to-log (item)
+  (sb-thread:with-mutex (*orchard-log-mutex*)
+    (setf (aref *orchard-log* *next-log-idx*) item)
+    (incf *next-log-idx*)))
+
+(defun apple-eater ()
+  (sb-thread:wait-on-semaphore *apples*)
+  (add-to-log "apple eaten."))
+
+(defun apple-grower ()
+  (sleep 0.1)
+  (add-to-log "apple grown.")
+  (sb-thread:signal-semaphore *apples*))
+
+(defun num-apples ()
+  (sb-thread:semaphore-count *apples*))
+
+(define-test test-orchard-simulation
+    (assert-equal (num-apples) ___)
+  (let ((eater-thread (sb-thread:make-thread 'apple-eater :name "apple eater thread")))
+    (let ((grower-thread (sb-thread:make-thread 'apple-grower :name "apple grower thread")))
+      (sb-thread:join-thread eater-thread)))
+  (assert-equal (aref *orchard-log* 0) ____)
+  (assert-equal (aref *orchard-log* 1) ____))
+
+
+
+

koans/triangle-project.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+"you need to write the triangle method"
+
+(define-condition triangle-error  (error) (()))
+
+(defun triangle (a b c)
+  :write-me)
+
+
+(define-test test-equilateral-triangles-have-equal-sides
+    (assert-equal :equilateral (triangle 2 2 2))
+    (assert-equal :equilateral (triangle 10 10 10)))
+
+
+(define-test test-isosceles-triangles-have-two-equal-sides
+    (assert-equal :isosceles (triangle 3 4 4))
+    (assert-equal :isosceles (triangle 4 3 4))
+    (assert-equal :isosceles (triangle 4 4 3))
+    (assert-equal :isosceles (triangle 10 10 2)))
+
+
+(define-test test-scalene-triangles-have-no-equal-sides
+    (assert-equal :scalene (triangle 3 4 5))
+    (assert-equal :scalene (triangle 10 11 12))
+    (assert-equal :scalene (triangle 5 4 2)))
+
+
+(define-test test-illegal-triangles-throw-exceptions
+    (assert-error 'triangle-error (triangle 0 0 0))
+    (assert-error 'triangle-error (triangle 3 4 -5))
+    (assert-error 'triangle-error (triangle 1 1 3))
+    (assert-error 'triangle-error (triangle 2 4 2)))

koans/type-checking.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+;; Common lisp types have hierarchy.  Any object may belong a family of types.
+;; The top level type, which includes everything else, is 't'
+
+(define-test test-check-some-common-types
+   (true-or-false? ___  (typep "hello" 'string))
+   (true-or-false? ___  (typep "hello" 'array))
+   (true-or-false? ___  (typep "hello" 'list))
+   (true-or-false? ___  (typep "hello" '(simple-array character (5))))
+
+   (true-or-false? ___  (typep '(1 2 3) 'list))
+   (true-or-false? ___  (typep 99 'integer))
+   (true-or-false? ___  (typep nil 'NULL))
+   (true-or-false? ___  (typep 22/7 'ratio))
+   (true-or-false? ___  (typep 4.0 'float))
+   (true-or-false? ___  (typep #\a 'character))
+   (true-or-false? ___  (typep #'length 'function)))
+
+
+(define-test test-get-type-with-type-of
+   (assert-equal ____ (type-of ()))
+   (assert-equal ____ (type-of 4/6)))
+
+(define-test test-type-sets-may-overlap
+   (true-or-false? ___  (typep () 'list))
+   (true-or-false? ___  (typep () 'atom))
+   (true-or-false? ___  (typep () 'NULL))
+   (true-or-false? ___  (typep () t)))
+
+
+(define-test test-integers-can-get-really-big
+   (true-or-false? ____ (typep 12345678901234567890123456789012 'integer))
+   ;; Integers are either fixnum or bignum.
+   ;; The boundary between fixnum and bignum is given by the constant:
+   ;;   most-positive-fixnum
+   (assert-true (typep 1234567890123456789 'fixnum))
+   (assert-true (typep 12345678901234567890 'bignum))
+   (true-or-false? ___ (typep most-positive-fixnum 'fixnum))
+   (true-or-false? ___ (typep (+ 1 most-positive-fixnum) 'fixnum)))
+
+
+(define-test test-lisp-type-system-is-hierarchy
+   (assert-true (typep 1 'bit))
+   (assert-true (typep 1 'integer))
+   (assert-true (typep 2 'integer))
+   (true-or-false? ____ (subtypep 'bit 'integer))
+   (true-or-false? ____ (subtypep (type-of 1) (type-of 2)))
+   (true-or-false? ____ (subtypep (type-of 2) (type-of 1))))
+
+
+(define-test test-some-types-are-lists
+   (assert-true(typep (make-array 0 :element-type 'integer) '(SIMPLE-VECTOR 0)))
+   (true-or-false? ____ (typep (make-array '(3 3) :element-type 'integer) '(SIMPLE-ARRAY T (3 3)))))
+
+
+(define-test test-type-specifier-lists-also-have-hierarchy
+   (true-or-false? ____ (subtypep '(SIMPLE-ARRAY T (3 3)) '(SIMPLE-ARRAY T *)))
+   (true-or-false? ____ (subtypep '(vector double-float 100) '(vector * 100)))
+   (true-or-false? ____ (subtypep '(vector double-float 100) '(vector double-float *)))
+   (true-or-false? ____ (subtypep '(vector double-float 100) '(vector * *)))
+   (true-or-false? ____ (subtypep '(vector double-float 100) '(array number *)))
+   (true-or-false? ____ (subtypep '(vector double-float 100) t)))
+
+
+(define-test test-type-coersion
+   (assert-true (typep 0 'integer))
+   (true-or-false? ___ (typep 0 'short-float))
+   (true-or-false? ___ (subtypep 'integer 'short-float))
+   (true-or-false? ___ (subtypep 'short-float 'integer))
+   (true-or-false? ___ (typep (coerce 0 'short-float) 'short-float)))
+
+
+(define-test test-atoms-are-anything-thats-not-a-cons
+  (true-or-false? ___ (atom 4))
+  (true-or-false? ___ (atom '(1 2 3 4)))
+  (true-or-false? ___ (atom 'some-unbound-name))
+  (assert-true (typep (make-array '(4 4)) '(SIMPLE-ARRAY * *)))
+  (true-or-false? ___ (atom (make-array '(4 4)))))
+
+
+(define-test test-functionp
+    "the functionp predicate is true iff the argument is a function"
+  (assert-true (functionp (lambda (a b c) (+ a b c))))
+  (true-or-false? ___ (functionp #'make-array))
+  (true-or-false? ___ (functionp '(1 2 3)))
+  (true-or-false? ___ (functionp t)))
+
+
+(define-test test-there-are-some-other-type-predicates
+  ; see http://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node73.html for more.
+  (true-or-false? ___ (numberp 999))
+  (true-or-false? ___ (listp '(9 9 9)))
+  (true-or-false? ___ (integerp 999))
+  (true-or-false? ___ (rationalp 9/99))
+  (true-or-false? ___ (floatp 9.99))
+  (true-or-false? ___ (stringp "nine nine nine"))
+  (true-or-false? ___ (characterp #\9))
+  (true-or-false? ___ (bit-vector-p #*01001)))
+
+
+(define-test test-guess-that-type!
+    (let ((x ____))
+      (assert-true (subtypep  x '(SIMPLE-ARRAY T (* 3 *))))
+      (assert-true (subtypep  x '(SIMPLE-ARRAY T (5 * *))))
+      (assert-true (subtypep  x '(SIMPLE-ARRAY ARRAY *)))
+      (assert-true (typep (make-array '(5 3 9) :element-type 'STRING ) x))
+      (assert-true (typep (make-array '(5 3 33) :element-type 'VECTOR ) x))))

koans/variables-parameters-constants.lsp

+(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))

koans/vectors.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+"vectors are just like rank 1 arrays"
+
+(define-test test-vector-types
+  " #(x y z) defines a vector literal containing x y z"
+  (true-or-false ___ (typep #(1 11 111) 'vector))
+  (assert-equal ___ (aref #(1 11 111) 1)))
+
+
+(define-test test-length-works-on-vectors
+  (assert-equal (length #(1 2 3)) ___ ))
+
+
+(define-test test-bit-vector
+    "#*0011 defines a bit vector literal with four elements, 0, 0, 1 and 1"
+  (assert-equal #*0011 (make-array '4 :element-type 'bit))
+  (true-or-false? ____ (typep #*1001 'bit-vector))
+  (assert-equal ____ (aref #*1001 1)))
+
+
+(define-test test-some-bitwise-operations
+    (assert-equal ___ (bit-and #*1100 #*1010))
+    (assert-equal ___ (bit-ior #*1100 #*1010))
+    (assert-equal ___ (bit-xor #*1100 #*1010)))
+
+
+(defun list-to-bit-vector (my-list)
+  nil)
+
+(define-test test-list-to-bit-vector
+    "you must complete list-to-bit-vector"
+  (assert-true (typep (list-to-bit-vector '(0 0 1 1 0)) 'bit-vector))
+  (assert-equal (aref (list-to-bit-vector '(0)) 0) 0)
+  (assert-equal (aref (list-to-bit-vector '(0 1)) 1) 1)
+  (assert-equal (length (list-to-bit-vector '(0 0 1 1 0 0 1 1))) 8))
+
+

lisp-unit.lsp

+;;;-*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
+
+#|
+This version of lisp-unit.lsp has been extended to support the lisp koans.
+Specifically, it is an unnamed branch from
+https://github.com/OdonataResearchLLC/lisp-unit/
+with hash 93d07b2fa6e32364916225f6218e9e7313027c1f
+
+Modifications were made to:
+   1) Support *incomplete* tests in addition to *passing* and *failing* ones
+   2) End test execution at the first non-passing test.
+|#
+
+
+#|
+Copyright (c) 2004-2005 Christopher K. Riesbeck
+
+Permission is hereby granted, free of charge, to any person obtaining 
+a copy of this software and associated documentation files (the "Software"), 
+to deal in the Software without restriction, including without limitation 
+the rights to use, copy, modify, merge, publish, distribute, sublicense, 
+and/or sell copies of the Software, and to permit persons to whom the 
+Software is furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included 
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS 
+OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 
+THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR 
+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 
+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 
+OTHER DEALINGS IN THE SOFTWARE.
+
+
+How to use
+----------
+
+1. Read the documentation at:
+   https://github.com/OdonataResearchLLC/lisp-unit/wiki
+
+2. Make a file of DEFINE-TEST's. See exercise-tests.lisp for many
+examples. If you want, start your test file with (REMOVE-TESTS :ALL)
+to clear any previously defined tests.
+
+3. Load this file.
+
+4. (use-package :lisp-unit)
+
+5. Load your code file and your file of tests.
+
+6. Test your code with (RUN-TESTS '(test-name1 test-name2 ...)) or
+simply (RUN-TESTS :ALL) to run all defined tests.
+
+A summary of how many tests passed and failed will be printed.
+
+NOTE: Nothing is compiled until RUN-TESTS is expanded. Redefining
+functions or even macros does not require reloading any tests.
+
+|#
+
+#|
+   Copyright 2013 Google Inc.
+
+   Licensed under the Apache License, Version 2.0 (the "License");
+   you may not use this file except in compliance with the License.
+   You may obtain a copy of the License at
+
+       http://www.apache.org/licenses/LICENSE-2.0
+
+   Unless required by applicable law or agreed to in writing, software
+   distributed under the License is distributed on an "AS IS" BASIS,
+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+   See the License for the specific language governing permissions and
+   limitations under the License.
+|#
+
+;;; Packages
+(in-package :cl-user)
+
+(defpackage :lisp-unit
+  (:use :common-lisp)
+  ;; Print parameters
+  (:export :*print-summary*
+           :*print-failures*
+           :*print-errors*
+           :*proceed-after-failure*)
+  ;; Forms for assertions
+  (:export :assert-eq
+           :assert-eql
+           :assert-equal
+           :true-or-false?
+           :assert-equalp
+           :assert-equality
+           :assert-prints
+           :assert-expands
+           :assert-true
+           :assert-false
+           :assert-error)
+  ;; Functions for managing tests
+  (:export :define-test
+           :list-tests
+           :test-code
+           :test-documentation
+           :remove-tests
+           :run-tests
+           :run-koans
+           :use-debugger)
+  ;; Functions for managing tags
+  (:export :list-tags
+           :tagged-tests
+           :remove-tags
+           :run-tags)
+  ;; Constants for blanks in koans
+  (:export __
+           ___
+           ____
+           +blanks+)
+  ;; Functions for reporting test results
+  (:export :test-names
+           :failed-tests
+           :incomplete-tests
+           :error-tests
+           :missing-tests
+           :summarize-results
+           :any-non-pass-p)
+  ;; Utility predicates
+  (:export :logically-equal :set-equal))
+
+(in-package :lisp-unit)
+
+
+;; blank constants allow the incomplete tests to compile without errors
+(defconstant __ :blank-value)
+(defconstant ___ :blank-value)
+(defconstant ____ :blank-value)
+(defconstant +blanks+ '(__ ___ ____))
+(defconstant +blank-value+ 'BLANK-VALUE)
+
+
+;;; Global counters
+
+(defparameter *pass* 0
+  "The number of passed assertions.")
+
+(defparameter *fail* 0
+  "The number of failed assertions.")
+
+(defparameter *incomplete* 0
+  "The number of incomplete assertions.")
+
+(defparameter *koan-assert-list* nil
+  "The record of a single koan.")
+
+;;; Global options
+
+(defparameter *proceed-after-failure* nil
+  "set to nil for normal operation.  t will eval every koan")
+
+(defparameter *print-summary* nil
+  "Print a summary of the pass, fail, and error count if non-nil.")
+
+(defparameter *print-failures* nil
+  "Print failure messages if non-NIL.")
+
+(defparameter *print-errors* nil
+  "Print error messages if non-NIL.")
+
+(defparameter *use-debugger* nil
+  "If not NIL, enter the debugger when an error is encountered in an
+assertion.")
+
+(defun use-debugger-p (condition)
+  "Debug or ignore errors."
+  (cond
+   ((eq :ask *use-debugger*)
+    (y-or-n-p "~A -- debug?" condition))
+   (*use-debugger*)))
+
+(defun use-debugger (&optional (flag t))
+  "Use the debugger when testing, or not."
+  (setq *use-debugger* flag))
+
+;;; Failure control strings
+
+(defgeneric print-failure (type form expected actual extras)
+  (:documentation
+   "Report the details of the failure assertion."))
+
+(defmethod print-failure :around (type form expected actual extras)
+  "Failure header and footer output."
+  (format t "~& | Failed Form: ~S" form)
+  (call-next-method)
+  (when extras
+    (format t "~{~& | ~S => ~S~}~%" (funcall extras)))
+  (format t "~& |~%")
+  type)
+
+(defmethod print-failure (type form expected actual extras)
+  (format t "~& | Expected ~{~S~^; ~} " expected)
+  (format t "~<~% | ~:;but saw ~{~S~^; ~}~>" actual))
+
+(defmethod print-failure ((type (eql :error))
+                          form expected actual extras)
+  (format t "~& | ~@[Should have signalled ~{~S~^; ~} but saw~]"
+          expected)
+  (format t " ~{~S~^; ~}" actual))
+
+(defmethod print-failure ((type (eql :macro))
+                          form expected actual extras)
+  (format t "~& | Should have expanded to ~{~S~^; ~} " expected)
+  (format t "~<~%~:;but saw ~{~S~^; ~}~>" actual))
+
+(defmethod print-failure ((type (eql :output))
+                          form expected actual extras)
+  (format t "~& | Should have printed ~{~S~^; ~} " expected)
+  (format t "~<~%~:;but saw ~{~S~^; ~}~>" actual))
+
+(defun print-error (condition)
+  "Print the error condition."
+  (let ((*print-escape* nil))
+    (format t "~& | Execution error:~% | ~W" condition)
+    (format t "~& |~%")))
+
+(defun print-summary (name pass fail incomplete &optional exerr)
+  "Print a summary of the test results."
+  (format t "~&~A: ~S assertions passed, ~S failed, ~S incomplete"
+          name pass fail incomplete)
+  (format t "~@[, ~S execution errors~].~2%" exerr))
+
+;;; Global unit test database
+
+(defparameter *test-db* (make-hash-table :test #'eq)
+  "The unit test database is simply a hash table.")
+
+(defun package-table (package &optional create)
+  (cond
+   ((gethash (find-package package) *test-db*))
+   (create
+    (setf (gethash package *test-db*) (make-hash-table)))
+   (t (warn "No tests defined for package: ~S" package))))
+
+;;; Global tags database
+
+(defparameter *tag-db* (make-hash-table :test #'eq)
+  "The tag database is simply a hash table.")
+
+(defun package-tags (package &optional create)
+  "Return the tags DB for the package."
+  (cond
+   ((gethash (find-package package) *tag-db*))
+   (create
+    (setf (gethash package *tag-db*) (make-hash-table)))
+   (t (warn "No tags defined for package: ~S" package))))
+
+(defclass unit-test ()
+  ((doc
+    :type string
+    :initarg :doc
+    :reader doc)
+   (code
+    :type list
+    :initarg :code
+    :reader code))
+  (:default-initargs :doc "" :code ())
+  (:documentation
+   "Organize the unit test documentation and code."))
+
+;;; NOTE: Shamelessly taken from PG's analyze-body
+(defun parse-body (body &optional doc tag)
+  "Separate the components of the body."
+  (let ((item (first body)))
+    (cond
+     ((and (listp item) (eq :tag (first item)))
+      (parse-body (rest body) doc (nconc (rest item) tag)))
+     ((and (stringp item) (not doc) (rest body))
+      (if tag
+          (values doc tag (rest body))
+          (parse-body (rest body) doc tag)))
+     (t (values doc tag body)))))
+
+(defmacro define-test (name &body body)
+  "Store the test in the test database."
+  (multiple-value-bind (doc tag code) (parse-body body)
+    `(let ((doc (or ,doc (string ',name))))
+       (setf
+        ;; Unit test
+        (gethash ',name (package-table *package* t))
+        (make-instance 'unit-test :doc doc :code ',code))
+       ;; Tags
+       (loop for tag in ',tag do
+             (pushnew
+              ',name (gethash tag (package-tags *package* t))))
+       ;; Return the name of the test
+       ',name)))
+
+;;; Manage tests
+
+(defun list-tests (&optional (package *package*))
+  "Return a list of the tests in package."
+  (let ((table (package-table package)))
+    (when table
+      (loop for test-name being each hash-key in table
+            collect test-name))))
+
+(defun test-documentation (name &optional (package *package*))
+  "Return the documentation for the test."
+  (let ((unit-test (gethash name (package-table package))))
+    (if (null unit-test)
+        (warn "No code defined for test ~A in package ~S."
+              name package)
+        (doc unit-test))))
+
+(defun test-code (name &optional (package *package*))
+  "Returns the code stored for the test name."
+  (let ((unit-test (gethash name (package-table package))))
+    (if (null unit-test)
+        (warn "No code defined for test ~A in package ~S."
+              name package)
+        (code unit-test))))
+
+(defun remove-tests (names &optional (package *package*))
+  "Remove individual tests or entire sets."
+  (if (eq :all names)
+      (if (null package)
+          (clrhash *test-db*)
+          (progn
+            (remhash (find-package package) *test-db*)
+            (remhash (find-package package) *tag-db*)))
+      (let ((table (package-table package)))
+        (unless (null table)
+          ;; Remove tests
+          (loop for name in names
+                always (remhash name table)
+                collect name into removed
+                finally (return removed))
+          ;; Remove tests from tags
+          (loop with tags = (package-tags package)
+                for tag being each hash-key in tags
+                using (hash-value tagged-tests)
+                do
+                (setf
+                 (gethash tag tags)
+                 (set-difference tagged-tests names)))))))
+
+;;; Manage tags
+
+(defun %tests-from-all-tags (&optional (package *package*))
+  "Return all of the tests that have been tagged."
+  (loop for tests being each hash-value in (package-tags package)
+        nconc (copy-list tests) into all-tests
+        finally (return (delete-duplicates all-tests))))
+
+(defun %tests-from-tags (tags &optional (package *package*))
+  "Return the tests associated with the tags."
+  (loop with table = (package-tags package)
+        for tag in tags
+        as tests = (gethash tag table)
+        nconc (copy-list tests) into all-tests
+        finally (return (delete-duplicates all-tests))))
+
+(defun list-tags (&optional (package *package*))
+  "Return a list of the tags in package."
+  (let ((tags (package-tags package)))
+    (when tags
+      (loop for tag being each hash-key in tags collect tag))))
+
+(defun tagged-tests (tags &optional (package *package*))
+  "Run the tests associated with the specified tags in package."
+  (if (eq :all tags)
+      (%tests-from-all-tags package)
+      (%tests-from-tags tags package)))
+
+(defun remove-tags (tags &optional (package *package*))
+  "Remove individual tags or entire sets."
+  (if (eq :all tags)
+      (if (null package)
+          (clrhash *tag-db*)
+          (remhash (find-package package) *tag-db*))
+      (let ((table (package-tags package)))
+        (unless (null table)
+          (loop for tag in tags
+                always (remhash tag table)
+                collect tag into removed
+                finally (return removed))))))
+
+;;; Assert macros
+
+(defmacro assert-eq (expected form &rest extras)
+  "Assert whether expected and form are EQ."
+  `(expand-assert :equal ,form ,form ,expected ,extras :test #'eq))
+
+(defmacro assert-eql (expected form &rest extras)
+  "Assert whether expected and form are EQL."
+  `(expand-assert :equal ,form ,form ,expected ,extras :test #'eql))
+
+(defmacro assert-equal (expected form &rest extras)
+  "Assert whether expected and form are EQUAL."
+  `(expand-assert :equal ,form ,form ,expected ,extras :test #'equal))
+
+(defmacro assert-equalp (expected form &rest extras)
+  "Assert whether expected and form are EQUALP."
+  `(expand-assert :equal ,form ,form ,expected ,extras :test #'equalp))
+
+(defmacro true-or-false? (expected form &rest extras)
+  "Assert whether expected and form are EQUAL."
+  `(expand-assert :equal ,form (not (not ,form)) ,expected ,extras :test #'equal))
+
+(defmacro assert-error (condition form &rest extras)
+  "Assert whether form signals condition."
+  `(expand-assert :error ,form (expand-error-form ,form)
+                  ,condition ,extras))
+
+(defmacro assert-expands (expansion form &rest extras)
+  "Assert whether form expands to expansion."
+  `(expand-assert :macro ,form
+                  (expand-macro-form ,form nil)
+                  ,expansion ,extras))
+
+(defmacro assert-false (form &rest extras)
+  "Assert whether the form is false."
+  `(expand-assert :result ,form ,form nil ,extras))
+
+(defmacro assert-equality (test expected form &rest extras)
+  "Assert whether expected and form are equal according to test."
+  `(expand-assert :equal ,form ,form ,expected ,extras :test ,test))
+
+(defmacro assert-prints (output form &rest extras)
+  "Assert whether printing the form generates the output."
+  `(expand-assert :output ,form (expand-output-form ,form)
+                  ,output ,extras))
+
+(defmacro assert-true (form &rest extras)
+  "Assert whether the form is true."
+  `(expand-assert :result ,form ,form t ,extras))
+
+(defmacro expand-assert (type form body expected extras &key (test '#'eql))
+  "Expand the assertion to the internal format."
+  `(internal-assert ,type ',form
+                    (lambda () ,body)
+                    (lambda () ,expected)
+                    (expand-extras ,extras)
+                    ,test))
+
+(defmacro expand-error-form (form)
+  "Wrap the error assertion in HANDLER-CASE."
+  `(handler-case ,form
+     (condition (error) error)))
+
+(defmacro expand-output-form (form)
+  "Capture the output of the form in a string."
+  (let ((out (gensym)))
+    `(let* ((,out (make-string-output-stream))
+            (*standard-output*
+             (make-broadcast-stream *standard-output* ,out)))
+       ,form
+       (get-output-stream-string ,out))))
+
+(defmacro expand-macro-form (form env)
+  "Expand the macro form once."
+  `(macroexpand-1 ',form ,env))
+
+(defmacro expand-extras (extras)
+  "Expand extra forms."
+  `(lambda ()
+     (list ,@(mapcan (lambda (form) (list `',form form)) extras))))
+
+;;; Test passed predicate.
+
+(defgeneric test-passed-p (type expected actual test)
+  (:documentation
+   "Return the result of the test."))
+
+(defmethod test-passed-p ((type (eql :error)) expected actual test)
+  "Return the result of the error assertion."
+  (or
+   (eql (car actual) (car expected))
+   (typep (car actual) (car expected))))
+
+(defmethod test-passed-p ((type (eql :equal)) expected actual test)
+  "Return the result of the equality assertion."
+  (and
+   (<= (length expected) (length actual))
+   (every test expected actual)))
+
+(defmethod test-passed-p ((type (eql :macro)) expected actual test)
+  "Return the result of the macro expansion."
+  (equal (car actual) (car expected)))
+
+(defmethod test-passed-p ((type (eql :output)) expected actual test)
+  "Return the result of the printed output."
+  (string=
+   (string-trim '(#\newline #\return #\space) (car actual))
+   (car expected)))
+
+;;; (LOGICALLY-EQUAL x y) => true or false
+;;;   Return true if x and y both false or both true
+(defun logically-equal (x y)
+  (eql (not x) (not y)))
+
+(defmethod test-passed-p ((type (eql :result)) expected actual test)
+  "Return the result of the assertion."
+  (logically-equal (car actual) (car expected)))
+
+(defun form-contains-one-of-p (form symbol-list)
+  ;; returns nil if form contains (recursively) no element of the symbol-list
+  ;; otherwise it returns the first element of symbol-list that it finds
+  ;; in form.
+  (cond
+    ((symbolp form) (find form symbol-list))
+    ((listp form) (or (form-contains-one-of-p (car form) symbol-list)
+                      (form-contains-one-of-p (cdr form) symbol-list)))
+    (t nil)))
+
+(defun internal-assert
+       (type form code-thunk expected-thunk extras test)  
+  "Perform the assertion and record the results."
+  (let* ((expected (multiple-value-list (funcall expected-thunk)))
+         (actual (multiple-value-list (funcall code-thunk)))
+         (passed (test-passed-p type expected actual test))
+         (incomplete (or (form-contains-one-of-p form +blanks+)
+                         (form-contains-one-of-p expected '(:blank-value)))))
+
+   (cond
+      (incomplete (progn
+                    (incf *incomplete*)
+                    (push :incomplete *koan-assert-list*)))
+      (passed (progn
+                (incf *pass*)
+                (push :pass *koan-assert-list*)))
+      (t (progn
+           (incf *fail*)
+           (push :fail *koan-assert-list*))))
+    ;; Report the assertion
+    (when (and (not passed) *print-failures*)
+      (print-failure type form expected actual extras))
+    ;; Return the result
+    passed))
+
+;;; results
+
+(defclass test-results ()
+  ((test-names
+    :type list
+    :initarg :test-names
+    :accessor test-names)
+   (pass
+    :type fixnum
+    :initform 0
+    :accessor pass)
+   (fail
+    :type fixnum
+    :initform 0
+    :accessor fail)
+   (incomplete
+    :type fixnum
+    :initform 0
+    :accessor incomplete)
+   (exerr
+    :type fixnum
+    :initform 0
+    :accessor exerr)
+   (failed-tests
+    :type list
+    :initform ()
+    :accessor failed-tests)
+   (incomplete-tests
+    :type list
+    :initform ()
+    :accessor incomplete-tests)
+   (error-tests
+    :type list
+    :initform ()
+    :accessor error-tests)
+   (missing-tests
+    :type list
+    :initform ()
+    :accessor missing-tests))
+  (:default-initargs :test-names ())
+  (:documentation
+   "Store the results of the tests for further evaluation."))
+
+(defmethod print-object ((object test-results) stream)
+  "Print the summary counts with the object."
+  (format stream "#<~A Total(~D) Passed(~D) Failed(~D) Incomplete(~D) Errors(~D)>~%"
+          (class-name (class-of object))
+          (+ (pass object) (fail object) (incomplete object))
+          (pass object) (fail object) (incomplete object) (exerr object)))
+
+(defun summarize-results (results)
+  "Print a summary of all results."
+  (let ((pass (pass results))
+        (fail (fail results))
+        (incomplete (incomplete results)))
+    (format t "~&Unit Test Summary~%")
+    (format t " | ~D assertions total~%" (+ pass fail incomplete))
+    (format t " | ~D passed~%" pass)
+    (format t " | ~D failed~%" fail)
+    (format t " | ~D incomplete~%" incomplete)
+    (format t " | ~D execution errors~%" (exerr results))
+    (format t " | ~D missing tests~2%"
+            (length (missing-tests results)))))
+
+;;; Run the tests
+
+(defun run-code (code)
+  "Run the code to test the assertions."
+  (funcall (coerce `(lambda () ,@code) 'function)))
+
+(defun run-test-thunk (code)
+  (let ((*pass* 0)
+        (*fail* 0)
+        (*incomplete* 0))
+    (handler-bind
+        ((error (lambda (condition)
+                  (when *print-errors*
+                    (print-error condition))
+                  (if (use-debugger-p condition)
+                      condition
+                      (return-from run-test-thunk
+                        (values *pass* *fail* *incomplete* condition))))))
+      (run-code code))
+    ;; Return the result count
+    (values *pass* *fail* *incomplete* nil)))
+
+(defun run-koan-thunk (code)
+  (let ((*koan-assert-list* nil))
+    (handler-bind
+        ((error (lambda (condition)
+                  (push :error *koan-assert-list*)
+                  (when *print-errors*
+                    (print-error condition))
+                  (if (use-debugger-p condition)
+                      condition
+                      (return-from run-koan-thunk
+                        (values *koan-assert-list* condition))))))
+      (run-code code))
+    ;; Return the result count
+    (values *koan-assert-list* nil)))
+
+(defun koan-result (code)
+   "Run the code.  Return a list of assertion result elements.
+    An assertion result element is one of :pass, :fail, :error, :incomplete"
+   (run-koan-thunk code))
+
+(defun record-result (test-name code results)
+  "Run the test code and record the result."
+  (multiple-value-bind (pass fail incomplete exerr)
+      (run-test-thunk code)
+    (push test-name (test-names results))
+    ;; Count passed tests
+    (when (plusp pass)
+      (incf (pass results) pass))
+    ;; Count failed tests and record name
+    (when (plusp fail)
+      (incf (fail results) fail)
+      (push test-name (failed-tests results)))
+    ;; Count incomplete tests and record name
+    (when (plusp incomplete)
+      (incf (incomplete results) incomplete)
+      (push test-name (incomplete-tests results)))
+    ;; Count errors and record name
+    (when exerr
+      (incf (exerr results))
+      (push test-name (error-tests results)))
+    ;; Print a summary of the results
+    (when (or *print-summary* *print-failures* *print-errors*)
+      (print-summary
+       test-name pass fail incomplete (when exerr 1)))))
+
+(defun %run-all-thunks (&optional (package *package*))
+  "Run all of the test thunks in the package."
+  (loop
+   with results = (make-instance 'test-results)
+   for test-name being each hash-key in (package-table package)
+   using (hash-value unit-test)
+   if unit-test do
+   (record-result test-name (code unit-test) results)
+   else do
+   (push test-name (missing-tests results))
+   ;; Summarize and return the test results
+   finally
+   (summarize-results results)
+   (return results)))
+
+(defun %run-thunks (test-names &optional (package *package*))
+  "Run the list of test thunks in the package."
+  (loop
+   with table = (package-table package)
+   and results = (make-instance 'test-results)
+   for test-name in test-names
+   as unit-test = (gethash test-name table)
+   if unit-test do
+   (record-result test-name (code unit-test) results)
+   else do
+   (push test-name (missing-tests results))
+   finally
+   (summarize-results results)
+   (return results)))
+
+(defun run-koans (package)
+  "Run the list of test thunks in the package. Stopping
+   at a failure or incomplete, with more helpful messaging"
+  (loop
+    with koan-results = nil
+    for test-name being each hash-key in (package-table package)
+    using (hash-value unit-test)
+    if unit-test do
+      (push (list test-name (koan-result (code unit-test))) koan-results)
+    else do
+      (push (list test-name :missing) koan-results)
+    until (and (not *proceed-after-failure*) (any-non-pass-p koan-results))
+    finally (return koan-results)))
+
+(defun any-non-pass-p (koan-results)
+  (dolist (one-koan koan-results)
+    (dolist (assert-result (second one-koan))
+      (if (not (equal :pass assert-result))
+          (return-from any-non-pass-p t))))
+  nil)
+
+(defun run-tests (test-names &optional (package *package*))
+  "Run the specified tests in package."
+  (if (eq :all test-names)
+      (%run-all-thunks package)
+      (%run-thunks test-names package)))
+
+(defun run-tags (tags &optional (package *package*))
+  "Run the tests associated with the specified tags in package."
+  (%run-thunks (tagged-tests tags package) package))
+
+;;; (SET-EQUAL l1 l2 :test) => true or false
+;;;   Return true if every element of l1 is an element of l2
+;;;   and vice versa.
+(defun set-equal (l1 l2 &key (test #'equal))
+  (and (listp l1)
+       (listp l2)
+       (subsetp l1 l2 :test test)
+       (subsetp l2 l1 :test test)))
+
+(pushnew :lisp-unit common-lisp:*features*)

unused-test-ideas.lsp

+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+
+; todo: add the nconc example somewhere and take care of the warning.
+
+'(define-test test-nconc
+    "nconc like append attaches one list to the end of the other, but
+     it does so in a more efficient, but potentially destructive way.
+     Lisp lists are nil terminated.  A symbol refers to the beginning of
+     a list, and then progresses to find the end.  'nconc' simply takes
+     the nil pointer at the end of the first list, and points it at the
+     beginning of the next list."
+  (assert-equal '(:a :b :c) (nconc '(:a :b) '(:c))) ;k
+
+  (let ((abc '(:a :b :c))
+        (xyz '(:x :y :z))
+        (abcxyz nil))
+    (setf abcxyz (nconc abc xyz))
+    (assert-equal '(:a :b :c :x :y :z) abcxyz)
+    (assert-equal '(:a :b :c :x :y :z) abc)
+    (assert-equal '(:x :y :z) xyz)))
+
+