pulled in lisp koans for solving

https://github.com/google/lisp-koans

flake.nix

@@ -7,7 +7,7 @@
         let pkgs = nixpkgs.legacyPackages.${system}; in
         {
           devShells.default = pkgs.mkShell {
-            buildInputs = [ pkgs.sbcl ];
+            buildInputs = [ pkgs.sbcl pkgs.inotify-tools ];
           };
         }
       );

lisp-koans/.git_bak/HEAD

@@ -0,0 +1 @@
+ref: refs/heads/master

lisp-koans/.git_bak/config

@@ -0,0 +1,11 @@
+[core]
+	repositoryformatversion = 0
+	filemode = true
+	bare = false
+	logallrefupdates = true
+[remote "origin"]
+	url = https://github.com/google/lisp-koans.git
+	fetch = +refs/heads/*:refs/remotes/origin/*
+[branch "master"]
+	remote = origin
+	merge = refs/heads/master

lisp-koans/.git_bak/description

@@ -0,0 +1 @@
+Unnamed repository; edit this file 'description' to name the repository.

lisp-koans/.git_bak/hooks/applypatch-msg.sample

@@ -0,0 +1,15 @@
+#!/nix/store/3j18grljsyy4nxc078g00sy4cx6cf16g-bash-5.1-p16/bin/bash
+#
+# An example hook script to check the commit log message taken by
+# applypatch from an e-mail message.
+#
+# The hook should exit with non-zero status after issuing an
+# appropriate message if it wants to stop the commit.  The hook is
+# allowed to edit the commit message file.
+#
+# To enable this hook, rename this file to "applypatch-msg".
+
+. git-sh-setup
+commitmsg="$(git rev-parse --git-path hooks/commit-msg)"
+test -x "$commitmsg" && exec "$commitmsg" ${1+"$@"}
+:

lisp-koans/.git_bak/hooks/commit-msg.sample

@@ -0,0 +1,24 @@
+#!/nix/store/3j18grljsyy4nxc078g00sy4cx6cf16g-bash-5.1-p16/bin/bash
+#
+# An example hook script to check the commit log message.
+# Called by "git commit" with one argument, the name of the file
+# that has the commit message.  The hook should exit with non-zero
+# status after issuing an appropriate message if it wants to stop the
+# commit.  The hook is allowed to edit the commit message file.
+#
+# To enable this hook, rename this file to "commit-msg".
+
+# Uncomment the below to add a Signed-off-by line to the message.
+# Doing this in a hook is a bad idea in general, but the prepare-commit-msg
+# hook is more suited to it.
+#
+# SOB=$(git var GIT_AUTHOR_IDENT | sed -n 's/^\(.*>\).*$/Signed-off-by: \1/p')
+# grep -qs "^$SOB" "$1" || echo "$SOB" >> "$1"
+
+# This example catches duplicate Signed-off-by lines.
+
+test "" = "$(grep '^Signed-off-by: ' "$1" |
+	 sort | uniq -c | sed -e '/^[ 	]*1[ 	]/d')" || {
+	echo >&2 Duplicate Signed-off-by lines.
+	exit 1
+}

lisp-koans/.git_bak/hooks/fsmonitor-watchman.sample

@@ -0,0 +1,173 @@
+#!/nix/store/c9d6q19a057kdh7gwpnnwlz79d8q6vx7-perl-5.34.1/bin/perl
+
+use strict;
+use warnings;
+use IPC::Open2;
+
+# An example hook script to integrate Watchman
+# (https://facebook.github.io/watchman/) with git to speed up detecting
+# new and modified files.
+#
+# The hook is passed a version (currently 2) and last update token
+# formatted as a string and outputs to stdout a new update token and
+# all files that have been modified since the update token. Paths must
+# be relative to the root of the working tree and separated by a single NUL.
+#
+# To enable this hook, rename this file to "query-watchman" and set
+# 'git config core.fsmonitor .git/hooks/query-watchman'
+#
+my ($version, $last_update_token) = @ARGV;
+
+# Uncomment for debugging
+# print STDERR "$0 $version $last_update_token\n";
+
+# Check the hook interface version
+if ($version ne 2) {
+	die "Unsupported query-fsmonitor hook version '$version'.\n" .
+	    "Falling back to scanning...\n";
+}
+
+my $git_work_tree = get_working_dir();
+
+my $retry = 1;
+
+my $json_pkg;
+eval {
+	require JSON::XS;
+	$json_pkg = "JSON::XS";
+	1;
+} or do {
+	require JSON::PP;
+	$json_pkg = "JSON::PP";
+};
+
+launch_watchman();
+
+sub launch_watchman {
+	my $o = watchman_query();
+	if (is_work_tree_watched($o)) {
+		output_result($o->{clock}, @{$o->{files}});
+	}
+}
+
+sub output_result {
+	my ($clockid, @files) = @_;
+
+	# Uncomment for debugging watchman output
+	# open (my $fh, ">", ".git/watchman-output.out");
+	# binmode $fh, ":utf8";
+	# print $fh "$clockid\n@files\n";
+	# close $fh;
+
+	binmode STDOUT, ":utf8";
+	print $clockid;
+	print "\0";
+	local $, = "\0";
+	print @files;
+}
+
+sub watchman_clock {
+	my $response = qx/watchman clock "$git_work_tree"/;
+	die "Failed to get clock id on '$git_work_tree'.\n" .
+		"Falling back to scanning...\n" if $? != 0;
+
+	return $json_pkg->new->utf8->decode($response);
+}
+
+sub watchman_query {
+	my $pid = open2(\*CHLD_OUT, \*CHLD_IN, 'watchman -j --no-pretty')
+	or die "open2() failed: $!\n" .
+	"Falling back to scanning...\n";
+
+	# In the query expression below we're asking for names of files that
+	# changed since $last_update_token but not from the .git folder.
+	#
+	# To accomplish this, we're using the "since" generator to use the
+	# recency index to select candidate nodes and "fields" to limit the
+	# output to file names only. Then we're using the "expression" term to
+	# further constrain the results.
+	if (substr($last_update_token, 0, 1) eq "c") {
+		$last_update_token = "\"$last_update_token\"";
+	}
+	my $query = <<"	END";
+		["query", "$git_work_tree", {
+			"since": $last_update_token,
+			"fields": ["name"],
+			"expression": ["not", ["dirname", ".git"]]
+		}]
+	END
+
+	# Uncomment for debugging the watchman query
+	# open (my $fh, ">", ".git/watchman-query.json");
+	# print $fh $query;
+	# close $fh;
+
+	print CHLD_IN $query;
+	close CHLD_IN;
+	my $response = do {local $/; <CHLD_OUT>};
+
+	# Uncomment for debugging the watch response
+	# open ($fh, ">", ".git/watchman-response.json");
+	# print $fh $response;
+	# close $fh;
+
+	die "Watchman: command returned no output.\n" .
+	"Falling back to scanning...\n" if $response eq "";
+	die "Watchman: command returned invalid output: $response\n" .
+	"Falling back to scanning...\n" unless $response =~ /^\{/;
+
+	return $json_pkg->new->utf8->decode($response);
+}
+
+sub is_work_tree_watched {
+	my ($output) = @_;
+	my $error = $output->{error};
+	if ($retry > 0 and $error and $error =~ m/unable to resolve root .* directory (.*) is not watched/) {
+		$retry--;
+		my $response = qx/watchman watch "$git_work_tree"/;
+		die "Failed to make watchman watch '$git_work_tree'.\n" .
+		    "Falling back to scanning...\n" if $? != 0;
+		$output = $json_pkg->new->utf8->decode($response);
+		$error = $output->{error};
+		die "Watchman: $error.\n" .
+		"Falling back to scanning...\n" if $error;
+
+		# Uncomment for debugging watchman output
+		# open (my $fh, ">", ".git/watchman-output.out");
+		# close $fh;
+
+		# Watchman will always return all files on the first query so
+		# return the fast "everything is dirty" flag to git and do the
+		# Watchman query just to get it over with now so we won't pay
+		# the cost in git to look up each individual file.
+		my $o = watchman_clock();
+		$error = $output->{error};
+
+		die "Watchman: $error.\n" .
+		"Falling back to scanning...\n" if $error;
+
+		output_result($o->{clock}, ("/"));
+		$last_update_token = $o->{clock};
+
+		eval { launch_watchman() };
+		return 0;
+	}
+
+	die "Watchman: $error.\n" .
+	"Falling back to scanning...\n" if $error;
+
+	return 1;
+}
+
+sub get_working_dir {
+	my $working_dir;
+	if ($^O =~ 'msys' || $^O =~ 'cygwin') {
+		$working_dir = Win32::GetCwd();
+		$working_dir =~ tr/\\/\//;
+	} else {
+		require Cwd;
+		$working_dir = Cwd::cwd();
+	}
+
+	return $working_dir;
+}

lisp-koans/.git_bak/hooks/post-update.sample

@@ -0,0 +1,8 @@
+#!/nix/store/3j18grljsyy4nxc078g00sy4cx6cf16g-bash-5.1-p16/bin/bash
+#
+# An example hook script to prepare a packed repository for use over
+# dumb transports.
+#
+# To enable this hook, rename this file to "post-update".
+
+exec git update-server-info

lisp-koans/.git_bak/hooks/pre-applypatch.sample

@@ -0,0 +1,14 @@
+#!/nix/store/3j18grljsyy4nxc078g00sy4cx6cf16g-bash-5.1-p16/bin/bash
+#
+# An example hook script to verify what is about to be committed
+# by applypatch from an e-mail message.
+#
+# The hook should exit with non-zero status after issuing an
+# appropriate message if it wants to stop the commit.
+#
+# To enable this hook, rename this file to "pre-applypatch".
+
+. git-sh-setup
+precommit="$(git rev-parse --git-path hooks/pre-commit)"
+test -x "$precommit" && exec "$precommit" ${1+"$@"}
+:

lisp-koans/.git_bak/hooks/pre-commit.sample

@@ -0,0 +1,49 @@
+#!/nix/store/3j18grljsyy4nxc078g00sy4cx6cf16g-bash-5.1-p16/bin/bash
+#
+# An example hook script to verify what is about to be committed.
+# Called by "git commit" with no arguments.  The hook should
+# exit with non-zero status after issuing an appropriate message if
+# it wants to stop the commit.
+#
+# To enable this hook, rename this file to "pre-commit".
+
+if git rev-parse --verify HEAD >/dev/null 2>&1
+then
+	against=HEAD
+else
+	# Initial commit: diff against an empty tree object
+	against=$(git hash-object -t tree /dev/null)
+fi
+
+# If you want to allow non-ASCII filenames set this variable to true.
+allownonascii=$(git config --type=bool hooks.allownonascii)
+
+# Redirect output to stderr.
+exec 1>&2
+
+# Cross platform projects tend to avoid non-ASCII filenames; prevent
+# them from being added to the repository. We exploit the fact that the
+# printable range starts at the space character and ends with tilde.
+if [ "$allownonascii" != "true" ] &&
+	# Note that the use of brackets around a tr range is ok here, (it's
+	# even required, for portability to Solaris 10's /usr/bin/tr), since
+	# the square bracket bytes happen to fall in the designated range.
+	test $(git diff --cached --name-only --diff-filter=A -z $against |
+	  LC_ALL=C tr -d '[ -~]\0' | wc -c) != 0
+then
+	cat <<\EOF
+Error: Attempt to add a non-ASCII file name.
+
+This can cause problems if you want to work with people on other platforms.
+
+To be portable it is advisable to rename the file.
+
+If you know what you are doing you can disable this check using:
+
+  git config hooks.allownonascii true
+EOF
+	exit 1
+fi
+
+# If there are whitespace errors, print the offending file names and fail.
+exec git diff-index --check --cached $against --

lisp-koans/.git_bak/hooks/pre-merge-commit.sample

@@ -0,0 +1,13 @@
+#!/nix/store/3j18grljsyy4nxc078g00sy4cx6cf16g-bash-5.1-p16/bin/bash
+#
+# An example hook script to verify what is about to be committed.
+# Called by "git merge" with no arguments.  The hook should
+# exit with non-zero status after issuing an appropriate message to
+# stderr if it wants to stop the merge commit.
+#
+# To enable this hook, rename this file to "pre-merge-commit".
+
+. git-sh-setup
+test -x "$GIT_DIR/hooks/pre-commit" &&
+        exec "$GIT_DIR/hooks/pre-commit"
+:

lisp-koans/.git_bak/hooks/pre-push.sample

@@ -0,0 +1,53 @@
+#!/nix/store/3j18grljsyy4nxc078g00sy4cx6cf16g-bash-5.1-p16/bin/bash
+
+# An example hook script to verify what is about to be pushed.  Called by "git
+# push" after it has checked the remote status, but before anything has been
+# pushed.  If this script exits with a non-zero status nothing will be pushed.
+#
+# This hook is called with the following parameters:
+#
+# $1 -- Name of the remote to which the push is being done
+# $2 -- URL to which the push is being done
+#
+# If pushing without using a named remote those arguments will be equal.
+#
+# Information about the commits which are being pushed is supplied as lines to
+# the standard input in the form:
+#
+#   <local ref> <local oid> <remote ref> <remote oid>
+#
+# This sample shows how to prevent push of commits where the log message starts
+# with "WIP" (work in progress).
+
+remote="$1"
+url="$2"
+
+zero=$(git hash-object --stdin </dev/null | tr '[0-9a-f]' '0')
+
+while read local_ref local_oid remote_ref remote_oid
+do
+	if test "$local_oid" = "$zero"
+	then
+		# Handle delete
+		:
+	else
+		if test "$remote_oid" = "$zero"
+		then
+			# New branch, examine all commits
+			range="$local_oid"
+		else
+			# Update to existing branch, examine new commits
+			range="$remote_oid..$local_oid"
+		fi
+
+		# Check for WIP commit
+		commit=$(git rev-list -n 1 --grep '^WIP' "$range")
+		if test -n "$commit"
+		then
+			echo >&2 "Found WIP commit in $local_ref, not pushing"
+			exit 1
+		fi
+	fi
+done
+
+exit 0

lisp-koans/.git_bak/hooks/pre-rebase.sample

@@ -0,0 +1,169 @@
+#!/nix/store/3j18grljsyy4nxc078g00sy4cx6cf16g-bash-5.1-p16/bin/bash
+#
+# Copyright (c) 2006, 2008 Junio C Hamano
+#
+# The "pre-rebase" hook is run just before "git rebase" starts doing
+# its job, and can prevent the command from running by exiting with
+# non-zero status.
+#
+# The hook is called with the following parameters:
+#
+# $1 -- the upstream the series was forked from.
+# $2 -- the branch being rebased (or empty when rebasing the current branch).
+#
+# This sample shows how to prevent topic branches that are already
+# merged to 'next' branch from getting rebased, because allowing it
+# would result in rebasing already published history.
+
+publish=next
+basebranch="$1"
+if test "$#" = 2
+then
+	topic="refs/heads/$2"
+else
+	topic=`git symbolic-ref HEAD` ||
+	exit 0 ;# we do not interrupt rebasing detached HEAD
+fi
+
+case "$topic" in
+refs/heads/??/*)
+	;;
+*)
+	exit 0 ;# we do not interrupt others.
+	;;
+esac
+
+# Now we are dealing with a topic branch being rebased
+# on top of master.  Is it OK to rebase it?
+
+# Does the topic really exist?
+git show-ref -q "$topic" || {
+	echo >&2 "No such branch $topic"
+	exit 1
+}
+
+# Is topic fully merged to master?
+not_in_master=`git rev-list --pretty=oneline ^master "$topic"`
+if test -z "$not_in_master"
+then
+	echo >&2 "$topic is fully merged to master; better remove it."
+	exit 1 ;# we could allow it, but there is no point.
+fi
+
+# Is topic ever merged to next?  If so you should not be rebasing it.
+only_next_1=`git rev-list ^master "^$topic" ${publish} | sort`
+only_next_2=`git rev-list ^master           ${publish} | sort`
+if test "$only_next_1" = "$only_next_2"
+then
+	not_in_topic=`git rev-list "^$topic" master`
+	if test -z "$not_in_topic"
+	then
+		echo >&2 "$topic is already up to date with master"
+		exit 1 ;# we could allow it, but there is no point.
+	else
+		exit 0
+	fi
+else
+	not_in_next=`git rev-list --pretty=oneline ^${publish} "$topic"`
+	/nix/store/c9d6q19a057kdh7gwpnnwlz79d8q6vx7-perl-5.34.1/bin/perl -e '
+		my $topic = $ARGV[0];
+		my $msg = "* $topic has commits already merged to public branch:\n";
+		my (%not_in_next) = map {
+			/^([0-9a-f]+) /;
+			($1 => 1);
+		} split(/\n/, $ARGV[1]);
+		for my $elem (map {
+				/^([0-9a-f]+) (.*)$/;
+				[$1 => $2];
+			} split(/\n/, $ARGV[2])) {
+			if (!exists $not_in_next{$elem->[0]}) {
+				if ($msg) {
+					print STDERR $msg;
+					undef $msg;
+				}
+				print STDERR " $elem->[1]\n";
+			}
+		}
+	' "$topic" "$not_in_next" "$not_in_master"
+	exit 1
+fi
+
+<<\DOC_END
+
+This sample hook safeguards topic branches that have been
+published from being rewound.
+
+The workflow assumed here is:
+
+ * Once a topic branch forks from "master", "master" is never
+   merged into it again (either directly or indirectly).
+
+ * Once a topic branch is fully cooked and merged into "master",
+   it is deleted.  If you need to build on top of it to correct
+   earlier mistakes, a new topic branch is created by forking at
+   the tip of the "master".  This is not strictly necessary, but
+   it makes it easier to keep your history simple.
+
+ * Whenever you need to test or publish your changes to topic
+   branches, merge them into "next" branch.
+
+The script, being an example, hardcodes the publish branch name
+to be "next", but it is trivial to make it configurable via
+$GIT_DIR/config mechanism.
+
+With this workflow, you would want to know:
+
+(1) ... if a topic branch has ever been merged to "next".  Young
+    topic branches can have stupid mistakes you would rather
+    clean up before publishing, and things that have not been
+    merged into other branches can be easily rebased without
+    affecting other people.  But once it is published, you would
+    not want to rewind it.
+
+(2) ... if a topic branch has been fully merged to "master".
+    Then you can delete it.  More importantly, you should not
+    build on top of it -- other people may already want to
+    change things related to the topic as patches against your
+    "master", so if you need further changes, it is better to
+    fork the topic (perhaps with the same name) afresh from the
+    tip of "master".
+
+Let's look at this example:
+
+		   o---o---o---o---o---o---o---o---o---o "next"
+		  /       /           /           /
+		 /   a---a---b A     /           /
+		/   /               /           /
+	       /   /   c---c---c---c B         /
+	      /   /   /             \         /
+	     /   /   /   b---b C     \       /
+	    /   /   /   /             \     /
+    ---o---o---o---o---o---o---o---o---o---o---o "master"
+
+
+A, B and C are topic branches.
+
+ * A has one fix since it was merged up to "next".
+
+ * B has finished.  It has been fully merged up to "master" and "next",
+   and is ready to be deleted.
+
+ * C has not merged to "next" at all.
+
+We would want to allow C to be rebased, refuse A, and encourage
+B to be deleted.
+
+To compute (1):
+
+	git rev-list ^master ^topic next
+	git rev-list ^master        next
+
+	if these match, topic has not merged in next at all.
+
+To compute (2):
+
+	git rev-list master..topic
+
+	if this is empty, it is fully merged to "master".
+
+DOC_END

lisp-koans/.git_bak/hooks/pre-receive.sample

@@ -0,0 +1,24 @@
+#!/nix/store/3j18grljsyy4nxc078g00sy4cx6cf16g-bash-5.1-p16/bin/bash
+#
+# An example hook script to make use of push options.
+# The example simply echoes all push options that start with 'echoback='
+# and rejects all pushes when the "reject" push option is used.
+#
+# To enable this hook, rename this file to "pre-receive".
+
+if test -n "$GIT_PUSH_OPTION_COUNT"
+then
+	i=0
+	while test "$i" -lt "$GIT_PUSH_OPTION_COUNT"
+	do
+		eval "value=\$GIT_PUSH_OPTION_$i"
+		case "$value" in
+		echoback=*)
+			echo "echo from the pre-receive-hook: ${value#*=}" >&2
+			;;
+		reject)
+			exit 1
+		esac
+		i=$((i + 1))
+	done
+fi

lisp-koans/.git_bak/hooks/prepare-commit-msg.sample

@@ -0,0 +1,42 @@
+#!/nix/store/3j18grljsyy4nxc078g00sy4cx6cf16g-bash-5.1-p16/bin/bash
+#
+# An example hook script to prepare the commit log message.
+# Called by "git commit" with the name of the file that has the
+# commit message, followed by the description of the commit
+# message's source.  The hook's purpose is to edit the commit
+# message file.  If the hook fails with a non-zero status,
+# the commit is aborted.
+#
+# To enable this hook, rename this file to "prepare-commit-msg".
+
+# This hook includes three examples. The first one removes the
+# "# Please enter the commit message..." help message.
+#
+# The second includes the output of "git diff --name-status -r"
+# into the message, just before the "git status" output.  It is
+# commented because it doesn't cope with --amend or with squashed
+# commits.
+#
+# The third example adds a Signed-off-by line to the message, that can
+# still be edited.  This is rarely a good idea.
+
+COMMIT_MSG_FILE=$1
+COMMIT_SOURCE=$2
+SHA1=$3
+
+/nix/store/c9d6q19a057kdh7gwpnnwlz79d8q6vx7-perl-5.34.1/bin/perl -i.bak -ne 'print unless(m/^. Please enter the commit message/..m/^#$/)' "$COMMIT_MSG_FILE"
+
+# case "$COMMIT_SOURCE,$SHA1" in
+#  ,|template,)
+#    /nix/store/c9d6q19a057kdh7gwpnnwlz79d8q6vx7-perl-5.34.1/bin/perl -i.bak -pe '
+#       print "\n" . `git diff --cached --name-status -r`
+# 	 if /^#/ && $first++ == 0' "$COMMIT_MSG_FILE" ;;
+#  *) ;;
+# esac
+
+# SOB=$(git var GIT_COMMITTER_IDENT | sed -n 's/^\(.*>\).*$/Signed-off-by: \1/p')
+# git interpret-trailers --in-place --trailer "$SOB" "$COMMIT_MSG_FILE"
+# if test -z "$COMMIT_SOURCE"
+# then
+#   /nix/store/c9d6q19a057kdh7gwpnnwlz79d8q6vx7-perl-5.34.1/bin/perl -i.bak -pe 'print "\n" if !$first_line++' "$COMMIT_MSG_FILE"
+# fi

lisp-koans/.git_bak/hooks/push-to-checkout.sample

@@ -0,0 +1,78 @@
+#!/nix/store/3j18grljsyy4nxc078g00sy4cx6cf16g-bash-5.1-p16/bin/bash
+
+# An example hook script to update a checked-out tree on a git push.
+#
+# This hook is invoked by git-receive-pack(1) when it reacts to git
+# push and updates reference(s) in its repository, and when the push
+# tries to update the branch that is currently checked out and the
+# receive.denyCurrentBranch configuration variable is set to
+# updateInstead.
+#
+# By default, such a push is refused if the working tree and the index
+# of the remote repository has any difference from the currently
+# checked out commit; when both the working tree and the index match
+# the current commit, they are updated to match the newly pushed tip
+# of the branch. This hook is to be used to override the default
+# behaviour; however the code below reimplements the default behaviour
+# as a starting point for convenient modification.
+#
+# The hook receives the commit with which the tip of the current
+# branch is going to be updated:
+commit=$1
+
+# It can exit with a non-zero status to refuse the push (when it does
+# so, it must not modify the index or the working tree).
+die () {
+	echo >&2 "$*"
+	exit 1
+}
+
+# Or it can make any necessary changes to the working tree and to the
+# index to bring them to the desired state when the tip of the current
+# branch is updated to the new commit, and exit with a zero status.
+#
+# For example, the hook can simply run git read-tree -u -m HEAD "$1"
+# in order to emulate git fetch that is run in the reverse direction
+# with git push, as the two-tree form of git read-tree -u -m is
+# essentially the same as git switch or git checkout that switches
+# branches while keeping the local changes in the working tree that do
+# not interfere with the difference between the branches.
+
+# The below is a more-or-less exact translation to shell of the C code
+# for the default behaviour for git's push-to-checkout hook defined in
+# the push_to_deploy() function in builtin/receive-pack.c.
+#
+# Note that the hook will be executed from the repository directory,
+# not from the working tree, so if you want to perform operations on
+# the working tree, you will have to adapt your code accordingly, e.g.
+# by adding "cd .." or using relative paths.
+
+if ! git update-index -q --ignore-submodules --refresh
+then
+	die "Up-to-date check failed"
+fi
+
+if ! git diff-files --quiet --ignore-submodules --
+then
+	die "Working directory has unstaged changes"
+fi
+
+# This is a rough translation of:
+#
+#   head_has_history() ? "HEAD" : EMPTY_TREE_SHA1_HEX
+if git cat-file -e HEAD 2>/dev/null
+then
+	head=HEAD
+else
+	head=$(git hash-object -t tree --stdin </dev/null)
+fi
+
+if ! git diff-index --quiet --cached --ignore-submodules $head --
+then
+	die "Working directory has staged changes"
+fi
+
+if ! git read-tree -u -m "$commit"
+then
+	die "Could not update working tree to new HEAD"
+fi

lisp-koans/.git_bak/hooks/update.sample

@@ -0,0 +1,128 @@
+#!/nix/store/3j18grljsyy4nxc078g00sy4cx6cf16g-bash-5.1-p16/bin/bash
+#
+# An example hook script to block unannotated tags from entering.
+# Called by "git receive-pack" with arguments: refname sha1-old sha1-new
+#
+# To enable this hook, rename this file to "update".
+#
+# Config
+# ------
+# hooks.allowunannotated
+#   This boolean sets whether unannotated tags will be allowed into the
+#   repository.  By default they won't be.
+# hooks.allowdeletetag
+#   This boolean sets whether deleting tags will be allowed in the
+#   repository.  By default they won't be.
+# hooks.allowmodifytag
+#   This boolean sets whether a tag may be modified after creation. By default
+#   it won't be.
+# hooks.allowdeletebranch
+#   This boolean sets whether deleting branches will be allowed in the
+#   repository.  By default they won't be.
+# hooks.denycreatebranch
+#   This boolean sets whether remotely creating branches will be denied
+#   in the repository.  By default this is allowed.
+#
+
+# --- Command line
+refname="$1"
+oldrev="$2"
+newrev="$3"
+
+# --- Safety check
+if [ -z "$GIT_DIR" ]; then
+	echo "Don't run this script from the command line." >&2
+	echo " (if you want, you could supply GIT_DIR then run" >&2
+	echo "  $0 <ref> <oldrev> <newrev>)" >&2
+	exit 1
+fi
+
+if [ -z "$refname" -o -z "$oldrev" -o -z "$newrev" ]; then
+	echo "usage: $0 <ref> <oldrev> <newrev>" >&2
+	exit 1
+fi
+
+# --- Config
+allowunannotated=$(git config --type=bool hooks.allowunannotated)
+allowdeletebranch=$(git config --type=bool hooks.allowdeletebranch)
+denycreatebranch=$(git config --type=bool hooks.denycreatebranch)
+allowdeletetag=$(git config --type=bool hooks.allowdeletetag)
+allowmodifytag=$(git config --type=bool hooks.allowmodifytag)
+
+# check for no description
+projectdesc=$(sed -e '1q' "$GIT_DIR/description")
+case "$projectdesc" in
+"Unnamed repository"* | "")
+	echo "*** Project description file hasn't been set" >&2
+	exit 1
+	;;
+esac
+
+# --- Check types
+# if $newrev is 0000...0000, it's a commit to delete a ref.
+zero=$(git hash-object --stdin </dev/null | tr '[0-9a-f]' '0')
+if [ "$newrev" = "$zero" ]; then
+	newrev_type=delete
+else
+	newrev_type=$(git cat-file -t $newrev)
+fi
+
+case "$refname","$newrev_type" in
+	refs/tags/*,commit)
+		# un-annotated tag
+		short_refname=${refname##refs/tags/}
+		if [ "$allowunannotated" != "true" ]; then
+			echo "*** The un-annotated tag, $short_refname, is not allowed in this repository" >&2
+			echo "*** Use 'git tag [ -a | -s ]' for tags you want to propagate." >&2
+			exit 1
+		fi
+		;;
+	refs/tags/*,delete)
+		# delete tag
+		if [ "$allowdeletetag" != "true" ]; then
+			echo "*** Deleting a tag is not allowed in this repository" >&2
+			exit 1
+		fi
+		;;
+	refs/tags/*,tag)
+		# annotated tag
+		if [ "$allowmodifytag" != "true" ] && git rev-parse $refname > /dev/null 2>&1
+		then
+			echo "*** Tag '$refname' already exists." >&2
+			echo "*** Modifying a tag is not allowed in this repository." >&2
+			exit 1
+		fi
+		;;
+	refs/heads/*,commit)
+		# branch
+		if [ "$oldrev" = "$zero" -a "$denycreatebranch" = "true" ]; then
+			echo "*** Creating a branch is not allowed in this repository" >&2
+			exit 1
+		fi
+		;;
+	refs/heads/*,delete)
+		# delete branch
+		if [ "$allowdeletebranch" != "true" ]; then
+			echo "*** Deleting a branch is not allowed in this repository" >&2
+			exit 1
+		fi
+		;;
+	refs/remotes/*,commit)
+		# tracking branch
+		;;
+	refs/remotes/*,delete)
+		# delete tracking branch
+		if [ "$allowdeletebranch" != "true" ]; then
+			echo "*** Deleting a tracking branch is not allowed in this repository" >&2
+			exit 1
+		fi
+		;;
+	*)
+		# Anything else (is there anything else?)
+		echo "*** Update hook: unknown type of update to ref $refname of type $newrev_type" >&2
+		exit 1
+		;;
+esac
+
+# --- Finished
+exit 0

lisp-koans/.git_bak/info/exclude

@@ -0,0 +1,6 @@
+# git ls-files --others --exclude-from=.git/info/exclude
+# Lines that start with '#' are comments.
+# For a project mostly in C, the following would be a good set of
+# exclude patterns (uncomment them if you want to use them):
+# *.[oa]
+# *~

lisp-koans/.git_bak/logs/HEAD

@@ -0,0 +1 @@
+0000000000000000000000000000000000000000 fa286eb6a98b0ab463c9c6da97b3113220d34216 efim <efim.nefedov@nordigy.ru> 1658664650 +0000	clone: from https://github.com/google/lisp-koans.git

lisp-koans/.git_bak/logs/refs/heads/master

@@ -0,0 +1 @@
+0000000000000000000000000000000000000000 fa286eb6a98b0ab463c9c6da97b3113220d34216 efim <efim.nefedov@nordigy.ru> 1658664650 +0000	clone: from https://github.com/google/lisp-koans.git

lisp-koans/.git_bak/packed-refs

@@ -0,0 +1,2 @@
+# pack-refs with: peeled fully-peeled sorted 
+fa286eb6a98b0ab463c9c6da97b3113220d34216 refs/remotes/origin/master

lisp-koans/.git_bak/refs/heads/master

@@ -0,0 +1 @@
+fa286eb6a98b0ab463c9c6da97b3113220d34216

lisp-koans/.koans

@@ -0,0 +1,34 @@
+(
+ #:asserts
+ #:nil-false-empty
+ #:evaluation
+ #:atoms-vs-lists
+ #:let
+ #:scope-and-extent
+ #:basic-macros
+ #:lists
+ #:arrays
+ #:vectors
+ #:multiple-values
+ #:equality-distinctions
+ #:hash-tables
+ #:functions
+ #:strings
+ #:structures
+ #:iteration
+ #:mapcar-and-reduce
+ #:control-statements
+ #:loops
+ #:scoring-project
+ #:format
+ #:type-checking
+ #:clos
+ #:std-method-comb
+ #:condition-handlers
+ #:triangle-project
+ #:dice-project
+ #:backquote
+ #:macros
+ #+quicklisp #:threads
+ #:extra-credit
+ )

lisp-koans/BUILD

@@ -0,0 +1,5 @@
+# Description: Common Lisp lisp-koans
+
+licenses(["notice"])  # Apache License 2.0 at //third_party/lisp/lisp-koans/LICENSE
+
+exports_files(["LICENSE"])

lisp-koans/LICENSE

@@ -0,0 +1,202 @@
+
+                                 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
+
+------------------------------------------------
+For test-framework: 
+
+The MIT License 
+
+Copyright (c) 2004-2005 Christopher K. Riesbeck
+
+ Permission is hereby granted, free of charge, to any person obtaining
+ a copy of this software and associated documentation files (the "Software"),
+ to deal in the Software without restriction, including without limitation
+ the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ and/or sell copies of the Software, and to permit persons to whom the
+ Software is furnished to do so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included
+ in all copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
+ OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
+ THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
+ OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
+ ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+ OTHER DEALINGS IN THE SOFTWARE.

lisp-koans/README.md

@@ -0,0 +1,108 @@
+# Lisp Koans
+
+## Getting Started
+
+### One-time Method
+
+From a terminal, execute your lisp interpreter on the file 'contemplate.lisp' e.g.
+
+    abcl --noinform --noinit --load contemplate.lisp --eval '(quit)'
+    ccl -n -l contemplate.lisp -e '(quit)'
+    clisp -q -norc -ansi contemplate.lisp
+    ecl -norc -load contemplate.lisp -eval '(quit)'
+    sbcl --script contemplate.lisp
+
+### Watching the Koans
+
+On Linux and MacOS systems, the shell scripts `meditate-linux.sh` and
+`meditate-macos.sh` can be used to automatically evaluate 'contemplate.lisp'
+whenever the koan files are modified, providing immediate feedback on changes
+to the koans. To run the MacOS version you need to have
+[`fswatch`](https://github.com/emcrisostomo/fswatch) installed. From a terminal:
+
+    $ cd lisp-koans
+    $ sh meditate-linux.sh # on Linux
+    $ sh meditate-macos.sh # on MacOS
+
+## Results of Contemplation
+
+Running on a fresh version should output the following:
+
+```
+Thinking about ASSERTS
+    FILL-IN-THE-BLANKS requires more meditation.
+
+You have not yet reached enlightenment.
+    A koan is incomplete.
+Please meditate on the following code:
+    File "koans/asserts.lisp"
+    Koan "FILL-IN-THE-BLANKS"
+    Current koan assert status is "(INCOMPLETE INCOMPLETE INCOMPLETE)"
+
+You are now 0/198 koans and 0/31 lessons closer to reaching enlightenment.
+```
+
+This indicates that the script has completed, and that the learner should look
+to asserts.lisp to locate and fix the problem.  The problem will be within
+a define-test expression such as
+
+```lisp
+;;; In order to progress, fill in the blanks, denoted via ____ in source code.
+;;; Sometimes, you will be asked to provide values that are equal to something.
+
+(define-test fill-in-the-blanks
+  (assert-equal ____ 2)
+  (assert-equal ____ 3.14)
+  (assert-equal ____ "Hello World"))
+
+;;; Sometimes, you will be asked to say whether something is true or false,
+;;; In Common Lisp, the canonical values for truth and falsehood are T and NIL.
+
+(define-test assert-true
+  (assert-true ____))
+
+(define-test assert-false
+  (assert-false ____))
+```
+
+In this case, the test is incomplete, and the student should fill
+in the blank (\_\_\_\_) with appropriate lisp code to make the assert pass.
+
+In order to test code, or evaluate tests interactively, students may copy
+and paste code into the lisp command line REPL.
+
+### Testing
+
+To test the koans, execute your lisp interpreter on the file 'contemplate.lisp' e.g.
+
+    abcl --noinform --noinit --load test.lisp --eval '(quit)'
+    ccl -n -l test.lisp -e '(quit)'
+    clisp -q -norc -ansi test.lisp
+    ecl -norc -load test.lisp -eval '(quit)'
+    sbcl --script test.lisp
+
+## Quoting the Ruby Koans instructions
+
+   "In test-driven development the mantra has always been, red, green,
+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 bordeaux-threads and bt-semaphore.
+The user must have Quicklisp installed and loaded or a reader macro
+will remove the instructions to run :threads.
+For information and instructions on installing Quicklisp
+please see:
+https://www.quicklisp.org/beta/
+The user can either remove #+quicklisp and uncomment
+(load "~/.quicklisp/setup.lisp") in threads.lisp, or  if they know
+quicklisp will be loaded while running contemplate.lisp do nothing.

lisp-koans/TODO

@@ -0,0 +1 @@
+*  improve error reporting from "a koan signaled an error" to something more helpful

lisp-koans/contemplate.lisp

@@ -0,0 +1,29 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+(in-package :cl-user)
+
+;;; Though Clozure / CCL runs lisp-koans on the command line using
+;;; "ccl -l contemplate.lisp", the following lines are needed to
+;;; meditate on the koans within the CCL IDE.
+;;; (The :hemlock is used to distiguish between ccl commandline and the IDE)
+#+(and :ccl :hemlock)
+(setf *default-pathname-defaults* (directory-namestring *load-pathname*))
+
+(load "test-framework.lisp")
+(load "lisp-koans.lisp")
+
+#+quicklisp (ql:quickload :bordeaux-threads)
+
+(lisp-koans.core:main)

lisp-koans/koans-solved/arrays.lisp

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

lisp-koans/koans-solved/asserts.lisp

@@ -0,0 +1,65 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+;;;                       ╭╮         ╭╮ ///////
+;;;                       ┃┃         ┃┃///////
+;;;                       ┃┃╭┳━━┳━━╮ ┃┃╭┳━━┳━━┳━╮╭━━╮
+;;;                       ┃┃┣┫━━┫╭╮┃ ┃╰╯┫╭╮┃╭╮┃╭╮┫━━┫
+;;;                       ┃╰┫┣━━┃╰╯┃ ┃╭╮┫╰╯┃╭╮┃┃┃┣━━┃
+;;;                       ╰━┻┻━━┫╭━╯/╰╯╰┻━━┻╯╰┻╯╰┻━━╯
+;;;                             ┃┃ //////
+;;;                             ╰╯//////
+
+;;; Welcome to the Lisp Koans.
+;;; May the code stored here influence your enlightenment as a programmer.
+
+;;; In order to progress, fill in the blanks, denoted via ____ in source code.
+;;; Sometimes, you will be asked to provide values that are equal to something.
+
+(define-test fill-in-the-blanks
+  (assert-equal 2 2)
+  (assert-equal 3.14 3.14)
+  (assert-equal "Hello World" "Hello World"))
+
+;;; Sometimes, you will be asked to say whether something is true or false,
+;;; In Common Lisp, the canonical values for truth and falsehood are T and NIL.
+
+(define-test assert-true
+  (assert-true t))
+
+(define-test assert-false
+  (assert-false nil))
+
+(define-test true-or-false
+  (true-or-false? t (= 34 34))
+  (true-or-false? nil (= 19 78)))
+
+;;; Since T and NIL are symbols, you can type them in lowercase or uppercase;
+;;; by default, Common Lisp will automatically upcase them upon reading.
+
+(define-test upcase-downcase
+  ;; Try inserting a lowercase t here.
+  (assert-equal t T)
+  ;; Try inserting an uppercase NIL here.
+  (assert-equal NIL nil))
+
+;;; Sometimes, you will be asked to provide a part of an expression that must be
+;;; either true or false.
+
+(define-test a-true-assertion
+  (assert-true (= 4 (+ 2 2))))
+
+(define-test a-false-assertion
+  (assert-false (= 5 (+ 2 2))))
+

lisp-koans/koans-solved/atoms-vs-lists.lisp

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

lisp-koans/koans-solved/backquote.lisp

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

lisp-koans/koans-solved/basic-macros.lisp

@@ -0,0 +1,112 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+(define-test setf
+  ;; SETF is a macro used to assign values to places. A place is a concept;
+  ;; it is an abstract "somewhere" where a value is stored.
+  (let ((a 10)
+        (b (list 1 20 30 40 50))
+        ;; We use COPY-SEQ to create a copy of a string, because using SETF to
+        ;; modify literal data (strings, lists, etc.) is undefined behaviour.
+        (c (copy-seq "I am Tom.")))
+    ;; A place may be a variable.
+    (setf a 1000)
+    (assert-equal 1000 a)
+    ;; A place may be a part of some list.
+    (setf (first b) 10)
+    (assert-equal '(10 20 30 40 50) b)
+    ;; A place may be a character in a string.
+    ;; The #\x syntax denotes a single character, 'x'.
+    (setf (char c 5) #\B
+          (char c 7) #\b)
+    (assert-equal "I am Bob." c)
+    ;; There are other kinds of places that we will explore in the future.
+    ))
+
+(define-test case
+  ;; CASE is a simple pattern-matching macro, not unlike C's "switch".
+  ;; It compares an input against a set of values and evaluates the code for
+  ;; the branch where a match is found.
+  (let* ((a 4)
+         (b (case a
+              (3 :three)
+              (4 :four)
+              (5 :five))))
+    (assert-equal :four b))
+  ;; CASE can accept a group of keys.
+  (let* ((c 4)
+         (d (case c
+              ((0 2 4 6 8) :even-digit)
+              ((1 3 5 7 9) :odd-digit))))
+    (assert-equal :even-digit d)))
+
+(defun match-special-cases (thing)
+  ;; T or OTHERWISE passed as the key matches any value.
+  ;; NIL passed as the key matches no values.
+  ;; These symbols need to passed in parentheses.
+  (case thing
+    ((t) :found-a-t)
+    ((nil) :found-a-nil)
+    (t :something-else)))
+
+(define-test special-cases-of-case
+  ;; You need to fill in the blanks in MATCH-SPECIAL-CASES.
+  (assert-equal :found-a-t (match-special-cases t))
+  (assert-equal :found-a-nil (match-special-cases nil))
+  (assert-equal :something-else (match-special-cases 42)))
+
+(define-test your-own-case-statement
+  ;; We use FLET to define a local function.
+  (flet ((cartoon-dads (input)
+           (case input
+             ;; Fill in the blanks with proper cases.
+             (:bart :homer)
+             (:stewie :peter)
+             (:stan :randy)
+             (:this-one-doesnt-happen :fancy-cat)
+             (t :unknown))))
+    (assert-equal (cartoon-dads :bart) :homer)
+    (assert-equal (cartoon-dads :stewie) :peter)
+    (assert-equal (cartoon-dads :stan) :randy)
+    (assert-equal (cartoon-dads :space-ghost) :unknown)))
+
+(define-test limits-of-case
+  ;; So far, we have been comparing objects using EQUAL, one of the Lisp
+  ;; comparison functions. CASE compares the keys using EQL, which is distinct
+  ;; from EQUAL.
+  ;; EQL is suitable for comparing numbers, characters, and objects for whom we
+  ;; want to check verify they are the same object.
+  (let* ((string "A string")
+         (string-copy (copy-seq string)))
+    ;; The above means that two distinct strings will not be the same under EQL,
+    ;; even if they have the same contents.
+    (true-or-false? nil (eql string string-copy))
+    (true-or-false? t (equal string string-copy))
+    ;; The above also means that CASE might give surprising results when used on
+    ;; strings.
+    (let ((match (case string
+                   ("A string" :matched)
+                   (t :not-matched))))
+      (assert-equal :not-matched match))
+    ;; We will explore this topic further in the EQUALITY-DISTINCTIONS lesson.
+    ))
+
+(define-test cond
+  ;; COND is similar to CASE, except it is more general. It accepts arbitrary
+  ;; conditions and checks them in order until one of them is met.
+  (let* ((number 4)
+         (result (cond ((> number 0) :positive)
+                       ((< number 0) :negative)
+                       (t :zero))))
+    (assert-equal :positive result)))

lisp-koans/koans-solved/clos.lisp

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

lisp-koans/koans-solved/condition-handlers.lisp

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

lisp-koans/koans-solved/control-statements.lisp

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

lisp-koans/koans-solved/dice-project.lisp

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

lisp-koans/koans-solved/equality-distinctions.lisp

@@ -0,0 +1,121 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+;;; The most common equality predicates in Common Lisp are, in order of
+;;; strictness, EQ, EQL, EQUAL, and EQUALP.
+
+(define-test eq
+  ;; EQ checks the identity of the two objects; it checks whether the two
+  ;; objects are, in fact, one and the same object.
+  ;; It is the fastest of the four; however, not guaranteed to work on numbers
+  ;; and characters because of that.
+  (true-or-false? t (eq 'a 'a))
+  (true-or-false? nil (eq 3 3.0))
+  (true-or-false? nil (eq '(1 2) '(1 2)))
+  (true-or-false? nil (eq "Foo" "Foo"))
+  (true-or-false? nil (eq "Foo" (copy-seq "Foo")))
+  (true-or-false? nil (eq "FOO" "Foo")))
+
+(define-test eql
+  ;; EQL works like EQ, except it is specified to work for numbers and
+  ;; characters.
+  ;; Two numbers are EQL if they are of the same type and represent the same
+  ;; number. Two characters are EQL if they represent the same character.
+  (true-or-false? t (eql 'a 'a))
+  (true-or-false? t (eql 3 3))
+  (true-or-false? nil (eql 3 3.0))
+  (true-or-false? nil (eql '(1 2) '(1 2)))
+  (true-or-false? nil (eql  '(:a . :b) '(:a . :b)))
+  (true-or-false? t (eql #\S #\S))
+  (true-or-false? nil (eql "Foo" "Foo"))
+  (true-or-false? nil (eql "Foo" (copy-seq "Foo")))
+  (true-or-false? nil (eql "FOO" "Foo")))
+
+(define-test equal
+  ;; EQUAL works like EQL, except works differently for lists, strings, bit
+  ;; vectors, and pathnames.
+  ;; Two lists, strings, bit arrays, or pathnames are EQUAL if they have EQUAL
+  ;; elements.
+  (true-or-false? t (equal 'a 'a))
+  (true-or-false? t (equal 3 3))
+  (true-or-false? nil (equal 3 3.0))
+  (true-or-false? t (equal '(1 2) '(1 2)))
+  (true-or-false? t (equal  '(:a . :b) '(:a . :b)))
+  (true-or-false? nil (equal  '(:a . :b) '(:a . :doesnt-match)))
+  (true-or-false? t (equal #\S #\S))
+  (true-or-false? t (equal "Foo" "Foo"))
+  (true-or-false? t (equal #*01010101 #*01010101))
+  (true-or-false? t (equal "Foo" (copy-seq "Foo")))
+  (true-or-false? nil (equal "FOO" "Foo"))
+  (true-or-false? t (equal #p"foo/bar/baz" #p"foo/bar/baz")))
+
+(defstruct thing slot-1 slot-2)
+
+(define-test equalp
+  ;; EQUALP works like EQUAL, except it works differently for characters,
+  ;; numbers, arrays, structures, and hash tables.
+  ;; Two characters are EQUALP if they represent the same character, ignoring
+  ;; the differences in character case.
+  ;; Two numbers are EQUALP if they represent the same number, even if they are
+  ;; of different types.
+  ;; Two arrays are EQUALP if they have the same dimensions and their characters
+  ;; are pairwise EQUALP.
+  ;; Two structures are EQUALP if they are of the same class and their slots are
+  ;; pairwise EQUALP.
+  ;; We will contemplate hash tables in the HASH-TABLES lesson.
+  (true-or-false? t (equalp 'a 'a))
+  (true-or-false? t (equalp 3 3))
+  (true-or-false? t (equalp 3 3.0))
+  (true-or-false? t (equalp '(1 2) '(1 2)))
+  (true-or-false? t (equalp  '(:a . :b) '(:a . :b)))
+  (true-or-false? nil (equalp  '(:a . :b) '(:a . :doesnt-match)))
+  (true-or-false? t (equalp #\S #\S))
+  (true-or-false? t (equalp "Foo" "Foo"))
+  (true-or-false? t (equalp "Foo" (copy-seq "Foo")))
+  (true-or-false? t (equalp "FOO" "Foo"))
+  (true-or-false? t (equalp (make-array '(4 2) :initial-element 0)
+                            (make-array '(4 2) :initial-element 0)))
+  (true-or-false? t (equalp (make-thing :slot-1 42 :slot-2 :forty-two)
+                            (make-thing :slot-1 42 :slot-2 :forty-two))))
+
+;;; In additional to the generic equality predicates, Lisp also provides
+;;; type-specific predicates for numbers, strings, and characters.
+
+(define-test =
+  ;; The function = behaves just like EQUALP on numbers.
+  ;; #C(... ...) is syntax sugar for creating a complex number.
+  (true-or-false? t (= 99.0 99 99.000 #C(99 0) #C(99.0 0.0)))
+  (true-or-false? nil (= 0 1 -1))
+  (true-or-false? t (= (/ 2 3) (/ 6 9) (/ 86 129))))
+
+(define-test string=
+  ;; The function STRING= behaves just like EQUAL on strings.
+  ;; The function STRING-EQUAL behaves just like EQUALP on strings.
+  (true-or-false? t (string= "Foo" "Foo"))
+  (true-or-false? nil (string= "Foo" "FOO"))
+  (true-or-false? t (string-equal "Foo" "FOO"))
+  ;; These functions accept additional keyword arguments that allow one to
+  ;; only compare parts of the strings.
+  (true-or-false? t (string= "together" "frog" :start1 1 :end1 3
+                                               :start2 2))
+  (true-or-false? t (string-equal "together" "FROG" :start1 1 :end1 3
+                                                    :start2 2)))
+
+(define-test char=
+  ;; The function CHAR= behaves just like EQL on characters.
+  ;; The function CHAR-EQUAL behaves just like EQUALP on characters.
+  (true-or-false? t (char= #\A (char "ABCDEF" 0)))
+  (true-or-false? nil (char= #\A #\a))
+  (true-or-false? t (char-equal #\A (char "ABCDEF" 0)))
+  (true-or-false? t (char-equal #\A #\a)))

lisp-koans/koans-solved/evaluation.lisp

@@ -0,0 +1,66 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+;;; In most imperative languages, the syntax of a function call has the function
+;;; name succeeded by a list of arguments. In Lisp, the function name and
+;;; arguments are all part of the same list, with the function name the first
+;;; element of that list.
+
+(define-test function-names
+  ;; In these examples, +, -, *, and / are function names.
+  (assert-equal 5 (+ 2 3))
+  (assert-equal -2 (- 1 3))
+  (assert-equal 28 (* 7 4))
+  (assert-equal 25 (/ 100 4)))
+
+(define-test numberp
+  ;; NUMBERP is a predicate which returns true if its argument is a number.
+  (assert-equal t (numberp 5))
+  (assert-equal t (numberp 2.0))
+  (assert-equal nil (numberp "five")))
+
+(define-test evaluation-order
+  ;; Arguments to a function are evaluated before the function is called.
+  (assert-equal 9 (* (+ 1 2) (- 13 10))))
+
+(define-test basic-comparisons
+  ;; The below functions are boolean functions (predicates) that operate on
+  ;; numbers.
+  (assert-equal t (> 25 4))
+  (assert-equal nil (< 8 2))
+  (assert-equal t (= 3 3))
+  (assert-equal t (<= 6 (/ 12 2)))
+  (assert-equal t (>= 20 (+ 1 2 3 4 5)))
+  (assert-equal t (/= 15 (+ 4 10))))
+
+(define-test quote
+  ;; Preceding a list with a quote (') will tell Lisp not to evaluate a list.
+  ;; The quote special form suppresses normal evaluation, and instead returns
+  ;; the literal list.
+  ;; Evaluating the form (+ 1 2) returns the number 3, but evaluating the form
+  ;; '(+ 1 2) returns the list (+ 1 2).
+  (assert-equal 3 (+ 1 2))
+  (assert-equal '(+ 1 2) '(+ 1 2))
+  (assert-equal '(+ 1 2) (list '+ 1 2))
+  ;; The 'X syntax is syntactic sugar for (QUOTE X).
+  (true-or-false? t (equal '(/ 4 0) (quote (/ 4 0)))))
+
+(define-test listp
+  ;; LISTP is a predicate which returns true if the argument is a list.
+  (assert-equal t (listp '(1 2 3)))
+  (assert-equal nil (listp 100))
+  (assert-equal nil (listp "Hello world"))
+  (assert-equal t (listp nil))
+  (assert-equal nil (listp (+ 1 2)))
+  (assert-equal t (listp '(+ 1 2))))

lisp-koans/koans-solved/extra-credit.lisp

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

lisp-koans/koans-solved/extra-credit.txt

@@ -0,0 +1,66 @@
+= Playing Greed
+
+Greed is a dice game played among 2 or more players, using 5
+six-sided dice.
+
+== Playing Greed
+
+Each player takes a turn consisting of one or more rolls of the dice.
+On the first roll of the game, a player rolls all five dice which are
+scored according to the following:
+
+  Three 1's => 1000 points
+  Three 6's =>  600 points
+  Three 5's =>  500 points
+  Three 4's =>  400 points
+  Three 3's =>  300 points
+  Three 2's =>  200 points
+  One   1   =>  100 points
+  One   5   =>   50 points
+
+A single die can only be counted once in each roll.  For example,
+a "5" can only count as part of a triplet (contributing to the 500
+points) or as a single 50 points, but not both in the same roll.
+
+Example Scoring
+
+   Throw       Score
+   ---------   ------------------
+   5 1 3 4 1   50 + 2 * 100 = 250
+   1 1 1 3 1   1000 + 100 = 1100
+   2 4 4 5 4   400 + 50 = 450
+
+The dice not contributing to the score are called the non-scoring
+dice.  "3" and "4" are non-scoring dice in the first example.  "3" is
+a non-scoring die in the second, and "2" is a non-score die in the
+final example.
+
+After a player rolls and the score is calculated, the scoring dice are
+removed and the player has the option of rolling again using only the
+non-scoring dice. If all of the thrown dice are scoring, then the
+player may roll all 5 dice in the next roll.
+
+The player may continue to roll as long as each roll scores points. If
+a roll has zero points, then the player loses not only their turn, but
+also accumulated score for that turn. If a player decides to stop
+rolling before rolling a zero-point roll, then the accumulated points
+for the turn is added to his total score.
+
+== Getting "In The Game"
+
+Before a player is allowed to accumulate points, they must get at
+least 300 points in a single turn. Once they have achieved 300 points
+in a single turn, the points earned in that turn and each following
+turn will be counted toward their total score.
+
+== End Game
+
+Once a player reaches 3000 (or more) points, the game enters the final
+round where each of the other players gets one more turn. The winner
+is the player with the highest score after the final round.
+
+== References
+
+Greed is described on Wikipedia at
+http://en.wikipedia.org/wiki/Greed_(dice_game), however the rules are
+a bit different from the rules given here.

lisp-koans/koans-solved/format.lisp

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

lisp-koans/koans-solved/functions.lisp

@@ -0,0 +1,184 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+(defun some-named-function (a b)
+  (+ a b))
+
+(define-test call-a-function
+  ;; DEFUN can be used to define global functions.
+  (assert-equal 9 (some-named-function 4 5))
+  ;; FLET can be used to define local functions.
+  (flet ((another-named-function (a b) (* a b)))
+    (assert-equal 20 (another-named-function 4 5)))
+  ;; LABELS can be used to define local functions which can refer to themselves
+  ;; or each other.
+  (labels ((recursive-function (a b)
+             (if (or (= 0 a) (= 0 b))
+                 1
+                 (+ (* a b) (recursive-function (1- a) (1- b))))))
+    (assert-equal 41 (recursive-function 4 5))))
+
+(define-test shadow-a-function
+  (assert-eq 18 (some-named-function 7 11))
+  ;; FLET and LABELS can shadow function definitions.
+  (flet ((some-named-function (a b) (* a b)))
+    (assert-equal 77 (some-named-function 7 11)))
+  (assert-equal 18 (some-named-function 7 11)))
+
+(defun function-with-optional-parameters (&optional (a 2) (b 3) c)
+  ;; If an optional argument to a function is not provided, it is given its
+  ;; default value, or NIL, if no default value is specified.
+  (list a b c))
+
+(define-test optional-parameters
+  (assert-equal '(42 24 4224) (function-with-optional-parameters 42 24 4224))
+  (assert-equal '(42 24 nil) (function-with-optional-parameters 42 24))
+  (assert-equal '(42 3 nil) (function-with-optional-parameters 42))
+  (assert-equal '(2 3 nil) (function-with-optional-parameters)))
+
+(defun function-with-optional-indication
+    (&optional (a 2 a-provided-p) (b 3 b-provided-p))
+  ;; It is possible to check whether an optional argument was provided.
+  (list a a-provided-p b b-provided-p))
+
+(define-test optional-indication
+  (assert-equal '(42 t 24 t) (function-with-optional-indication 42 24))
+  (assert-equal '(42 t 3 nil) (function-with-optional-indication 42))
+  (assert-equal '(2 nil 3 nil) (function-with-optional-indication)))
+
+(defun function-with-rest-parameter (&rest x)
+  ;; A rest parameter gathers all remaining parameters in a list.
+  x)
+
+(define-test rest-parameter
+  (assert-equal '() (function-with-rest-parameter))
+  (assert-equal '(1) (function-with-rest-parameter 1))
+  (assert-equal '(1 :two 333) (function-with-rest-parameter 1 :two 333)))
+
+(defun function-with-keyword-parameters (&key (a :something) b c)
+  ;; A keyword parameters is similar to an optional parameter, but is provided
+  ;; by a keyword-value pair.
+  (list a b c))
+
+(define-test keyword-parameters ()
+  (assert-equal '(:something nil nil) (function-with-keyword-parameters))
+  (assert-equal '(11 22 33) (function-with-keyword-parameters :a 11 :b 22 :c 33))
+  ;; It is not necessary to specify all keyword parameters.
+  (assert-equal '(:something 22 nil) (function-with-keyword-parameters :b 22))
+  ;; Keyword argument order is not important.
+  (assert-equal '(0 22 -5/2)
+                (function-with-keyword-parameters :b 22 :c -5/2 :a 0))
+  ;; Lisp handles duplicate keyword parameters.
+  (assert-equal '(:something 22 nil)
+                (function-with-keyword-parameters :b 22 :b 40 :b 812)))
+
+(defun function-with-keyword-indication
+    (&key (a 2 a-provided-p) (b 3 b-provided-p))
+  ;; It is possible to check whether a keyword argument was provided.
+  (list a a-provided-p b b-provided-p))
+
+(define-test keyword-indication
+  (assert-equal '(2 nil 3 nil) (function-with-keyword-indication))
+  (assert-equal '(3 t 4 t) (function-with-keyword-indication :a 3 :b 4))
+  (assert-equal '(11 t 22 t) (function-with-keyword-indication :a 11 :b 22))
+  (assert-equal '(2 nil 22 t) (function-with-keyword-indication :b 22))
+  (assert-equal '(0 t 22 t) (function-with-keyword-indication :b 22 :a 0)))
+
+(defun function-with-funky-parameters (a &rest x &key b (c a c-provided-p))
+  ;; Lisp functions can have surprisingly complex lambda lists.
+  ;; A &rest parameter must come before &key parameters.
+  (list a b c c-provided-p x))
+
+(define-test funky-parameters
+  (assert-equal '(1 nil 1 nil nil) (function-with-funky-parameters 1))
+  (assert-equal '(1 2 1 nil (:b 2)) (function-with-funky-parameters 1 :b 2))
+  (assert-equal '(1 2 3 t (:b 2 :c 3))
+                (function-with-funky-parameters 1 :b 2 :c 3))
+  (assert-equal '(1 2 3 t (:c 3 :b 2))
+                (function-with-funky-parameters 1 :c 3 :b 2)))
+
+(define-test lambda
+  ;; A list form starting with the symbol LAMBDA denotes an anonymous function.
+  ;; It is possible to call that function immediately or to store it for later
+  ;; use.
+  (let ((my-function (lambda (a b) (* a b))))
+    (assert-equal 99 (funcall my-function 11 9)))
+  ;; A LAMBDA form is allowed to take the place of a function name.
+  (assert-equal 19 ((lambda (a b) (+ a b)) 10 9))
+  (let ((functions (list (lambda (a b) (+ a b))
+                         (lambda (a b) (- a b))
+                         (lambda (a b) (* a b))
+                         (lambda (a b) (/ a b)))))
+    (assert-equal 35 (funcall (first functions) 2 33))
+    (assert-equal -31 (funcall (second functions) 2 33))
+    (assert-equal 66 (funcall (third functions) 2 33))
+    (assert-equal 2/33 (funcall (fourth functions) 2 33))))
+
+(define-test lambda-with-optional-parameters
+  (assert-equal 19 ((lambda (a &optional (b 100)) (+ a b)) 10 9))
+  (assert-equal 110 ((lambda (a &optional (b 100)) (+ a b)) 10)))
+
+(defun make-adder (x)
+  ;; MAKE-ADDER will create a function that closes over the parameter X.
+  ;; The parameter will be remembered as a part of the environment of the
+  ;; returned function, which will continue refering to it.
+  (lambda (y) (+ x y)))
+
+(define-test lexical-closures
+  (let ((adder-100 (make-adder 100))
+        (adder-500 (make-adder 500)))
+    ;; ADD-100 and ADD-500 now close over different values.
+    (assert-equal 103 (funcall adder-100 3))
+    (assert-equal 503 (funcall adder-500 3))))
+
+(defun make-reader-and-writer (x)
+  ;; Both returned functions will refer to the same place.
+  (list (function (lambda () x))
+        (function (lambda (y) (setq x y)))))
+
+(define-test lexical-closure-interactions
+  ;; The macro DESTRUCTURING-BIND is like LET, except it binds the variables
+  ;; listed in its first argument to the parts of the list returned by the form
+  ;; that is its second argument.
+  (destructuring-bind (reader-1 writer-1) (make-reader-and-writer 1)
+    (destructuring-bind (reader-2 writer-2) (make-reader-and-writer :one)
+      (assert-equal 1 (funcall reader-1))
+      (funcall writer-1 0)
+      (assert-equal 0 (funcall reader-1))
+      ;; The two different function pairs refer to different places.
+      (assert-equal :one (funcall reader-2))
+      (funcall writer-2 :zero)
+      (assert-equal :zero (funcall reader-2)))))
+
+(define-test apply
+  ;; The function APPLY applies a function to a list of arguments.
+  (let ((function (lambda (x y z) (+ x y z))))
+    (assert-equal 123 (apply function '(100 20 3))))
+  ;; FUNCTION is a special operator that retrieves function objects, defined
+  ;; both globally and locally. #'X is syntax sugar for (FUNCTION X).
+  (assert-equal 3 (apply (function +) '(1 2)))
+  (assert-equal -1 (apply #'- '(1 2)))
+  ;; Only the last argument to APPLY must be a list.
+  (assert-equal 6 (apply #'+ 1 2 '(3)))
+  (assert-equal 4 (apply #'max 1 2 3 4 '())))
+
+(define-test funcall
+  ;; The function FUNCALL calls a function with arguments, not expecting a final
+  ;; list of arguments.
+  (let ((function (lambda (x y z) (+ x y z))))
+    (assert-equal 321 (funcall function 300 20 1)))
+  (assert-equal 3 (funcall (function +) 1 2))
+  (assert-equal -1 (funcall #'- 1 2))
+  (assert-equal 6 (funcall #'+ 1 2 3))
+  (assert-equal 4 (funcall #'max 1 2 3 4)))

lisp-koans/koans-solved/hash-tables.lisp

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

lisp-koans/koans-solved/iteration.lisp

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

lisp-koans/koans-solved/let.lisp

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

lisp-koans/koans-solved/lists.lisp

@@ -0,0 +1,146 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+;;; A singly linked list is the basic build block of Lisp. Each node of such a
+;;; list is called a "cons cell" in Lisp. Each cons cell has two slots: a CAR,
+;;; often used to hold an element of a list, and a CDR, often used to reference
+;;; the next cons cell.
+
+(define-test how-to-make-lists
+  (let (;; Literal lists can be passed by quoting them.
+        (fruits '(orange pomello clementine))
+        ;; Freshly constructed lists can be passed using the LIST function.
+        (some-evens (list (* 2 1) (* 2 2) (* 2 3)))
+        ;; Lists can also be passed using quotes and dot notation...
+        (long-numbers '(16487302 . (3826700034 . (10000000 . nil))))
+        ;; ...or by using the function CONS.
+        (names (cons "Matthew" (cons "Mark" (cons "Margaret" '())))))
+    ;; Try filling in the below blanks in different ways.
+    (assert-equal '(orange pomello clementine) fruits)
+    (assert-equal '(2 4 6) some-evens)
+    (assert-equal '(16487302 3826700034 10000000) long-numbers)
+    (assert-equal '("Matthew" "Mark" "Margaret") names)))
+
+(define-test cons-tructing-lists
+  ;; The function CONS can be used to add new elements at the beginning of
+  ;; an existing list.
+  (let ((nums '()))
+    (setf nums (cons :one nums))
+    (assert-equal '(:one) nums)
+    (setf nums (cons :two nums))
+    (assert-equal '(:two :one) nums)
+    ;; Lists can contain anything, even objects of different types.
+    (setf nums (cons 333 nums))
+    (assert-equal '(333 :two :one) nums)
+    ;; Lists can contain other lists, too.
+    (setf nums (cons (list "some" "strings") nums))
+    (assert-equal '(("some" "strings") 333 :two :one) nums)))
+
+(define-test car-and-cdr
+  ;; We may use functions CAR and CDR (or, alternatively, FIRST and REST) to
+  ;; access the two slots of a cons cell.
+  (let ((x (cons 1 2)))
+    (assert-equal 1 (car x))
+    (assert-equal 2 (cdr x)))
+  ;; Calls to CAR and CDR are often intertwined to extract data from a nested
+  ;; cons structure.
+  (let ((structure '((1 2) (("foo" . "bar")))))
+    (assert-equal '(1 2) (car structure))
+    (assert-equal '(("foo" . "bar")) (car (cdr structure)))
+    (assert-equal "bar" (cdr (car (car (cdr structure)))))
+    ;; Lisp defines shorthand functions for up to four such nested calls.
+    (assert-equal '(1 2) (car structure))
+    (assert-equal '(("foo" . "bar")) (cadr structure))
+    (assert-equal "bar" (cdaadr structure))))
+
+(define-test push-pop
+  ;; PUSH and POP are macros similar to SETF, as both of them operate on places.
+  (let ((place '(10 20 30 40)))
+    ;; PUSH sets the value of the place to a new cons cell containing some value
+    ;; in its CAR.
+    (push 0 place)
+    (assert-equal '(0 10 20 30 40) place)
+    ;; POP removes a single cons cell from a place, sets the place to its CDR,
+    ;; and returns the value from its CAR.
+    (let ((value (pop place)))
+      (assert-equal 0 value)
+      (assert-equal '(10 20 30 40) place))
+    ;; The return value of POP can be discarded to simply "remove" a single cons
+    ;; cell from a place.
+    (pop place)
+    (let ((value (pop place)))
+      (assert-equal 20 value)
+      (assert-equal '(30 40) place))))
+
+(define-test append-nconc
+  ;; The functions APPEND and NCONC appends one list to the end of another.
+  ;; While APPEND creates new lists, NCONC modifies existing ones; therefore
+  ;; APPEND can be used on literals, but NCONC needs fresh lists.
+  (assert-equal '(:a :b :c) (append '(:a :b) '(:c)))
+  (assert-equal '(:a :b :c) (nconc (list :a :b) (list :c)))
+  (let ((list-1 (list 1 2 3))
+        (list-2 (list 4 5 6)))
+    ;; Both APPEND and NCONC return the appended list, but the interesting part
+    ;; is what happens when we try to use the original variables passed to them.
+    (assert-equal '(1 2 3 4 5 6) (append list-1 list-2))
+    (assert-equal '(1 2 3) list-1)
+    (assert-equal '(4 5 6) list-2)
+    (assert-equal '(1 2 3 4 5 6) (nconc list-1 list-2))
+    (assert-equal '(1 2 3 4 5 6) list-1)
+    (assert-equal '(4 5 6) list-2)))
+
+(define-test accessing-list-elements
+  (let ((noms '("peanut" "butter" "and" "jelly")))
+    ;; Common Lisp defines accessor functions for lists: FIRST, SECOND, ...,
+    ;; up to TENTH.
+    (assert-equal "peanut" (first noms))
+    (assert-equal "butter" (second noms))
+    (assert-equal "jelly" (fourth noms))
+    ;; The function LAST returns the last cons cell of a list.
+    (assert-equal '("jelly") (last noms))
+    ;; The function NTH returns the n-th element of a list.
+    (assert-equal "butter" (nth 1 noms))
+    (assert-equal "peanut" (nth 0 noms))
+    (assert-equal "jelly" (nth 3 noms))))
+
+(define-test cons-tructing-improper-lists
+  ;; A proper list is a list whose final CDR ends with NIL.
+  ;; An improper list either has a non-NIL value in its final CDR or does not
+  ;; have a final CDR due to a cycle in its structure.
+  (let (;; We can construct non-cyclic improper lists using LIST*...
+        (x (list* 1 2 3 4 5))
+        ;; ...or pass them as literals via dot notation.
+        (y '(6 7 8 9 . 0)))
+    (assert-equal '(4 . 5) (last x))
+    (assert-equal '(9 . 0) (last y)))
+  ;; We can create a cyclic list by changing the last CDR of a list to refer to
+  ;; another cons cell
+  (let ((list (list 1 2 3 4 5))
+        (cyclic-list (list 1 2 3 4 5)))
+    (setf (cdr (last cyclic-list)) cyclic-list)
+    ;; Function LIST-LENGTH returns NIL if a list is cyclic.
+    (assert-equal 5 (list-length list))
+    (assert-equal nil (list-length cyclic-list))
+    ;; Many Lisp functions operate only on proper lists.
+    ;; The function NTH is not one of them; it can be used to retrieve elements
+    ;; of cyclic lists.
+    (assert-equal 2 (nth 101 cyclic-list))))
+
+(define-test slicing-lists
+  ;; The function SUBSEQ returns a subsequence of a list.
+  (let ((noms (list "peanut" "butter" "and" "jelly")))
+    (assert-equal '("peanut") (subseq noms 0 1))
+    (assert-equal '("peanut" "butter") (subseq noms 0 2))
+    (assert-equal '() (subseq noms 2 2))
+    (assert-equal '("and" "jelly") (subseq noms 2))))

lisp-koans/koans-solved/loops.lisp

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

lisp-koans/koans-solved/macros.lisp

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

lisp-koans/koans-solved/mapcar-and-reduce.lisp

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

lisp-koans/koans-solved/multiple-values.lisp

@@ -0,0 +1,41 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+;;; In Lisp, it is possible for a function to return more than one value.
+;;; This is distinct from returning a list or structure of values.
+
+(define-test multiple-values
+  (let ((x (floor 3/2))
+        ;; The macro MULTIPLE-VALUE-LIST returns a list of all values returned
+        ;; by a Lisp form.
+        (y (multiple-value-list (floor 3/2))))
+    (assert-equal x 1)
+    (assert-equal y '(1 1/2)))
+  (assert-equal '(24 3/4) (multiple-value-list (floor 99/4))))
+
+(defun next-fib (a b)
+  ;; The function VALUES allows returning multiple values.
+  (values b (+ a b)))
+
+(define-test binding-and-setting-multiple-values
+  ;; The macro MULTIPLE-VALUE-BIND is like LET, except it binds the variables
+  ;; listed in its first argument to the values returned by the form that is its
+  ;; second argument.
+  (multiple-value-bind (x y) (next-fib 3 5)
+    (let ((result (* x y)))
+      (assert-equal 40 result)))
+  ;; SETF can also set multiple values if a VALUES form is provided as a place.
+  (let (x y)
+    (setf (values x y) (next-fib 5 8))
+    (assert-equal '(8 13) (list x y))))

lisp-koans/koans-solved/nil-false-empty.lisp

@@ -0,0 +1,52 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+(define-test t-and-nil-are-opposites
+  ;; NOT is a function which returns the boolean opposite of its argument.
+  (true-or-false? t (not nil))
+  (true-or-false? nil (not t)))
+
+(define-test nil-and-empty-list-are-the-same-thing
+  ;; In Common Lisp, NIL is also the empty list.
+  (true-or-false? nil '())
+  (true-or-false? t (not '())))
+
+(define-test in-lisp-many-things-are-true
+  ;; In Common Lisp, the canonical values for truth is T.
+  ;; However, everything that is non-NIL is true, too.
+  (true-or-false? t 5)
+  (true-or-false? nil (not 5))
+  (true-or-false? t "a string")
+  ;; Even an empty string...
+  (true-or-false? t "")
+  ;; ...or a list containing a NIL...
+  (true-or-false? t (list nil))
+  ;; ...or an array with no elements...
+  (true-or-false? t (make-array 0))
+  ;; ...or the number zero.
+  (true-or-false? t 0))
+
+(define-test and
+  ;; The logical operator AND can take multiple arguments.
+  (true-or-false? t (and t t t t t))
+  (true-or-false? nil (and t t nil t t))
+  ;; If all values passed to AND are true, it returns the last value.
+  (assert-equal 5 (and t t t t t 5)))
+
+(define-test or
+  ;; The logical operator OR can also take multiple arguments.
+  (true-or-false? t  (or nil nil nil t nil))
+  ;; OR returns the first non-NIL value it encounters, or NIL if there are none.
+  (assert-equal nil (or nil nil nil))
+  (assert-equal 1 (or 1 2 3 4 5)))

lisp-koans/koans-solved/scope-and-extent.lisp

@@ -0,0 +1,48 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+(define-test shadowing
+  (assert-equal '(4 2) (let ((z 4)) (list z (let ((z 2)) z)))))
+
+(defun block-1 ()
+  (block here
+    (return-from here 4)
+    5))
+
+(defun block-2 ()
+  (block outer
+    (block inner
+      (return-from outer 'space)
+      (return-from inner 'tube))
+    (return-from outer 'valve)))
+
+(define-test block-return-from
+  (assert-equal 4 (block-1))
+  (assert-equal 'space (block-2)))
+
+;;; See http://www.gigamonkeys.com/book/variables.html
+
+(define-test lexical-variables-can-be-enclosed
+  (assert-equal 10 (let ((f (let ((x 10))
+                              (lambda () x))))
+                     (let ((x 20))
+                       (funcall f)))))
+
+(define-test dynamic-variables-are-affected-by-execution-path
+  (assert-equal 20 (let ((f (let ((x 10))
+                              (declare (special x))
+                              (lambda () x))))
+                     (let ((x 20))
+                       (declare (special x))
+                       (funcall f)))))

lisp-koans/koans-solved/scoring-project.lisp

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

lisp-koans/koans-solved/std-method-comb.lisp

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

lisp-koans/koans-solved/strings.lisp

@@ -0,0 +1,73 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+(define-test what-is-a-string
+  (let ((string "Do, or do not. There is no try."))
+    (true-or-false? t (typep string 'string))
+    ;; Strings are vectors of characters.
+    (true-or-false? t (typep string 'array))
+    (true-or-false? t (typep string 'vector))
+    (true-or-false? t (typep string '(vector character)))
+    (true-or-false? nil (typep string 'integer))))
+
+(define-test multiline-string
+  ;; A Lisp string can span multiple lines.
+  (let ((string "this is
+                 a multi
+                 line string"))
+    (true-or-false? t (typep string 'string))))
+
+(define-test escapes-in-strings
+  ;; Quotes and backslashes in Lisp strings must be escaped.
+  (let ((my-string "this string has one of these \" and a \\ in it"))
+    (true-or-false? t (typep my-string 'string))))
+
+(define-test substrings
+  ;; Since strings are sequences, it is possible to use SUBSEQ on them.
+  (let ((string "Lorem ipsum dolor sit amet"))
+    (assert-equal "dolor sit amet" (subseq string 12))
+    (assert-equal "ipsum" (subseq string 6 11))
+    (assert-equal "orem" (subseq string 1 5))))
+
+(define-test strings-versus-characters
+  ;; Strings and characters have distinct types.
+  (true-or-false? t (typep #\a 'character))
+  (true-or-false? nil (typep "A" 'character))
+  (true-or-false? nil (typep #\a 'string))
+  ;; One can use both AREF and CHAR to refer to characters in a string.
+  (let ((my-string "Cookie Monster"))
+    (assert-equal #\C (char my-string 0))
+    (assert-equal #\k (char my-string 3))
+    (assert-equal #\M (aref my-string 7))))
+
+(define-test concatenating-strings
+  ;; Concatenating strings in Common Lisp is possible, if a little cumbersome.
+  (let ((a "Lorem")
+        (b "ipsum")
+        (c "dolor"))
+    (assert-equal "Lorem ipsum dolor" (concatenate 'string a " " b " " c))))
+
+(define-test searching-for-characters
+  ;; The function POSITION can be used to find the first position of an element
+  ;; in a sequence. If the element is not found, NIL is returned.
+  (assert-equal 1 (position #\b "abc"))
+  (assert-equal 2 (position #\c "abc"))
+  (assert-equal nil (position #\d "abc")))
+
+(define-test finding-substrings
+  ;; The function SEARCH can be used to search a sequence for subsequences.
+  (let ((title "A supposedly fun thing I'll never do again"))
+    (assert-equal 2 (search "supposedly" title))
+    (assert-equal 12 (search " fun" title))))
+

lisp-koans/koans-solved/structures.lisp

@@ -0,0 +1,111 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+;;; Lisp structures encapsulate data which belongs together. They are a template
+;;; of sorts, providing a way to generate multiple instances of uniformly
+;;; organized information
+;;; Defining a structure also interns accessor functions to get and set the
+;;; slots of that structure.
+
+;;; The following form creates a new structure class named BASKETBALL-PLAYER
+;;; with slots named NAME, TEAM, and NUMBER.
+;;; This additionally creates functions MAKE-BASKETBALL-PLAYER,
+;;; COPY-BASKETBALL-PLAYER, BASKETBALL-PLAYER-P, BASKETBALL-PLAYER-NAME,
+;;; BASKETBALL-PLAYER-TEAM, and BASKETBALL-PLAYER-NUMBER.
+
+(defstruct basketball-player
+  name team number)
+
+(define-test make-struct
+  (let ((player (make-basketball-player :name "Larry" :team :celtics
+                                        :number 33)))
+    (true-or-false? t (basketball-player-p player))
+    (assert-equal "Larry" (basketball-player-name player))
+    (assert-equal :celtics (basketball-player-team player))
+    (assert-equal 33 (basketball-player-number player))
+    (setf (basketball-player-team player) :retired)
+    (assert-equal :retired (basketball-player-team player))))
+
+;;; Structure fields can have default values.
+
+(defstruct baseball-player
+  name (team :red-sox) (position :outfield))
+
+(define-test struct-defaults
+  (let ((player (make-baseball-player)))
+    ;; We have not specified a default value for NAME, therefore we cannot
+    ;; read it here - it would invoke undefined behaviour.
+    (assert-equal :red-sox (baseball-player-team player))
+    (assert-equal :outfield (baseball-player-position player))))
+
+;;; The accessor names can get pretty long. It's possible to specify a different
+;;; prefix with the :CONC-NAME option.
+
+(defstruct (american-football-player (:conc-name nfl-guy-))
+  name position team)
+
+(define-test struct-access
+  (let ((player (make-american-football-player
+                 :name "Drew Brees" :position :qb :team "Saints")))
+    (assert-equal "Drew Brees" (nfl-guy-name player))
+    (assert-equal "Saints" (nfl-guy-team player))
+    (assert-equal :qb (nfl-guy-position player))))
+
+;;; Structs can be defined to include other structure definitions.
+;;; This form of inheritance allows composition of objects.
+
+(defstruct (nba-contract (:include basketball-player))
+  salary start-year end-year)
+
+(define-test structure-inheritance
+  (let ((contract (make-nba-contract :salary 136000000
+                                     :start-year 2004 :end-year 2011
+                                     :name "Kobe Bryant"
+                                     :team :lakers :number 24)))
+    (assert-equal 2004 (nba-contract-start-year contract))
+    (assert-equal 'nba-contract (type-of contract))
+    ;; Inherited structures follow the rules of type hierarchy.
+    (true-or-false? t (typep contract 'basketball-player))
+    ;; One can access structure fields both with the structure's own accessors
+    ;; and with the inherited accessors.
+    (assert-equal :lakers (nba-contract-team contract))
+    (assert-equal :lakers (basketball-player-team contract))))
+
+;;; Copying a structure named FOO is handled with the COPY-FOO function.
+;;; All such copies are shallow.
+
+(define-test structure-equality-and-copying
+  (let ((manning-1 (make-american-football-player
+                    :name "Manning" :team (list "Colts" "Broncos")))
+        (manning-2 (make-american-football-player
+                    :name "Manning" :team (list "Colts" "Broncos"))))
+    ;; MANNING-1 and MANNING-2 are different objects...
+    (true-or-false? nil (eq manning-1 manning-2))
+    ;;...but they contain the same information.
+    (true-or-false? t (equalp manning-1 manning-2))
+    (let ((manning-3 (copy-american-football-player manning-1)))
+      (true-or-false? nil (eq manning-1 manning-3))
+      (true-or-false? t (equalp manning-1 manning-3))
+      ;; Setting the slot of one instance does not modify the others...
+      (setf (nfl-guy-name manning-1) "Rogers")
+      (true-or-false? nil (string= (nfl-guy-name manning-1)
+                                   (nfl-guy-name manning-3)))
+      (assert-equal "Rogers" (nfl-guy-name manning-1))
+      (assert-equal "Manning" (nfl-guy-name manning-3))
+      ;; ...but modifying shared structure may affect other instances.
+      (setf (car (nfl-guy-team manning-1)) "Giants")
+      (true-or-false? t (string= (car (nfl-guy-team manning-1))
+                                 (car (nfl-guy-team manning-3))))
+      (assert-equal "Giants" (car (nfl-guy-team manning-1)))
+      (assert-equal "Giants" (car (nfl-guy-team manning-3))))))

lisp-koans/koans-solved/threads.lisp

@@ -0,0 +1,161 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+;;; This lesson group uses Quicklisp to load Bordeaux Threads, a portability
+;;; library for working with threads. This is because threads are not a part of
+;;; the Common Lisp standard and implementations do them differently.
+;;; If you are using Quicklisp, please feel free to enable this lesson by
+;;; following the instructions in the README.
+
+;;; TODO: wait for Bordeaux Threads to implement a portable SEMAPHORE-COUNT
+;;; and use it in the semaphore koans.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-test thread-return-value
+  ;; When a thread object is constructed, it accepts a function to execute.
+  (let* ((thread (bt:make-thread (lambda () (+ 2 2))))
+         ;; When the thread's function finishes, its return value becomes the
+         ;; return value of BT:JOIN-THREAD.
+         (value (bt:join-thread thread)))
+    (assert-equal ____ value)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar *variable*)
+
+(define-test thread-global-bindings
+  ;; The global value of a variable is shared between all threads.
+  (setf *variable* 42)
+  (let ((thread (bt:make-thread (lambda ()
+                                  (when (= *variable* 42)
+                                    (setf *variable* 24)
+                                    t)))))
+    (assert-true (bt:join-thread thread))
+    (assert-equal ____ *variable*)))
+
+(define-test thread-local-bindings
+  ;; Newly established local bindings of a variable are visible only in the
+  ;; thread that established these bindings.
+  (setf *variable* 42)
+  (let ((thread (bt:make-thread (lambda ()
+                                  (let ((*variable* 42))
+                                    (setf *variable* 24))))))
+    (bt:join-thread thread)
+    (assert-equal ____ *variable*)))
+
+(define-test thread-initial-bindings
+  ;; Initial dynamic bindings may be passed to the new thread.
+  (setf *variable* 42)
+  (let ((thread (bt:make-thread (lambda () (setf *variable* 24))
+                                :initial-bindings '((*variable* . 42)))))
+    (bt:join-thread thread)
+    (assert-equal ____ *variable*)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-test thread-name
+  ;; Threads can have names.
+  (let ((thread (bt:make-thread #'+ :name "Summing thread")))
+    (assert-equal ____ (bt:thread-name thread))
+    (assert-equal ____ (bt:join-thread thread))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-test thread-function-arguments
+  ;; Passing arguments to thread functions requires closing over them.
+  (let* ((x 240)
+         (y 18)
+         (thread (bt:make-thread (lambda () (* x y)))))
+    (assert-equal ____ (bt:join-thread thread))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-test destroy-thread
+  ;; Looping and renegade threads can usually be killed via BT:DESTROY-THREAD.
+  ;; It is the last measure, since doing so might leave the Lisp system in an
+  ;; unpredictable state if the thread was doing something complex.
+  (let ((thread (bt:make-thread (lambda () (loop (sleep 1))))))
+    (true-or-false? ____ (bt:thread-alive-p thread))
+    (bt:destroy-thread thread)
+    (true-or-false? ____ (bt:thread-alive-p thread))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar *another-variable*)
+
+;; Preventing concurrent access to some data can be achieved via a lock in
+;; order to avoid race conditions.
+
+(defvar *lock* (bt:make-lock))
+
+(define-test lock
+  (setf *another-variable* 0)
+  (flet ((increaser () (bt:with-lock-held (*lock*) (incf *another-variable*))))
+    (loop repeat 100
+          collect (bt:make-thread #'increaser) into threads
+          finally (loop until (notany #'bt:thread-alive-p threads))
+                  (assert-equal ____ *another-variable*))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; We can further orchestrate threads by using semaphores.
+
+(defvar *semaphore* (bt:make-semaphore))
+
+(defun signal-our-semaphore ()
+  (bt:signal-semaphore semaphore))
+
+(defun wait-on-our-semaphore ()
+  (bt:wait-on-semaphore semaphore :timeout 100))
+
+(define-test semaphore
+  (assert-equal 1 (bt:join-thread (bt:make-thread #'signal-our-semaphore)))
+  (assert-equal ____ (bt:join-thread (bt:make-thread #'signal-our-semaphore)))
+  (assert-equal ____ (bt:join-thread (bt:make-thread #'signal-our-semaphore)))
+  (assert-equal 2 (bt:join-thread (bt:make-thread #'wait-on-our-semaphore)))
+  (assert-equal ____ (bt:join-thread (bt:make-thread #'wait-on-our-semaphore)))
+  (assert-equal ____ (bt:join-thread (bt:make-thread #'wait-on-our-semaphore)))
+  (assert-equal ____ (bt:join-thread (bt:make-thread #'wait-on-our-semaphore))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Semaphores can be used to manage resource allocation and to trigger some
+;; threads to run when the semaphore value is above zero.
+
+(defvar *foobar-semaphore* (bt:make-semaphore))
+
+(defvar *foobar-list*)
+
+(defun bar-pusher ()
+  (dotimes (i 10)
+    (sleep 0.01)
+    (push i (nth i *foobar-list*))
+    (push :bar (nth i *foobar-list*))
+    ;; We push :BAR before :FOO, so the final list looks like (:FOO :BAR).
+    (bt:signal-semaphore *foobar-semaphore*)))
+
+(defun foo-pusher ()
+  (dotimes (i 10)
+    (bt:wait-on-semaphore *foobar-semaphore*)
+    (push :foo (nth i *foobar-list*))))
+
+(define-test list-of-foobars
+  (setf *foobar-list* (make-list 10))
+  (let ((bar-pusher (bt:make-thread #'bar-pusher))
+        (foo-pusher (bt:make-thread #'foo-pusher)))
+    (bt:join-thread foo-pusher))
+  (assert-equal ____ (nth 0 *foobar-list*))
+  (assert-equal ____ (nth 1 *foobar-list*))
+  (assert-equal ____ (nth 5 *foobar-list*)))

lisp-koans/koans-solved/triangle-project.lisp

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

lisp-koans/koans-solved/type-checking.lisp

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

lisp-koans/koans-solved/variables-parameters-constants.lisp

@@ -0,0 +1,88 @@
+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+(defun test-variable-assignment-with-setf ()
+  ;; the let pattern allows us to create local variables with
+  ;; lexical scope.
+  (let (var_name_1 (var_name_2 "Michael"))
+  ;; variables may be defined with or without initial values.
+  (and
+   (equalp var_name_2 "Michael")
+   ; new values may be assigned to variables with setf
+   (setf var_name_2 "Janet")
+   (equalp var_name_2 "Janet")
+   ; setf may assign multiple variables in one form.
+   (setf var_name_1 "Tito"
+         var_name_2 "Jermaine")
+   (equalp var_name_1 "Tito")
+   (equalp var_name_2 "Jermaine"))))
+
+(defun test-setf-for-lists ()
+  ;; setf also works on list elements
+  (let (l)
+    (setf l '(1 2 3))
+    (equalp l '(1 2 3))
+    ; First second and third are convenient accessor functions
+    ; referring to the elements of a list
+    ; For those interested, they are convenient to car, cadr, and caddr
+    (setf (first l) 10)
+    (setf (second l) 20)
+    (setf (third l) 30)
+    (equalp l '(10 20 30))))
+
+(defparameter param_name_1 "Janet")
+; defparameter requires an initial form.  It is a compiler error to exclude it
+;(defparameter param_no_init)  ;; this will fail
+(defconstant additive_identity 0)
+; defconstant also requires an initial form
+; (defconstant constant_no_init)
+
+; reassigning parameters to new values is also ok, but parameters carry the
+; connotation of immutability.  If it's going to change frequently, it should
+; be a var.
+(setf param_name_1 "The other one")
+
+; reassigning a constant is an error.
+; this should result in a compile time error
+; (setf additive_identity -1)
+
+
+;; -------------------------------
+;; below is necessary to run tests.
+;; -------------------------------
+
+(defvar failed-test-names nil)
+
+(defun run-test (testfun)
+  (let ((fun-name (function-name testfun)))
+    (if (apply testfun '())
+        (format t ".")
+        (progn
+          (setf failed-test-names (cons fun-name failed-test-names))
+          (format t "F")))))
+
+(defun function-name (function) (nth-value 2 (function-lambda-expression function)))
+
+
+(run-test #'test-variable-assignment-with-setf)
+(run-test #'test-setf-for-lists)
+
+(format t "~%")
+
+(defun report-failure (test-name)
+  (format t "~S failed.~%" test-name))
+
+(if (endp failed-test-names)  ; no failed tests
+    (format t "all tests pass.~%")
+    (mapcar #'report-failure failed-test-names))

lisp-koans/koans-solved/vectors.lisp

@@ -0,0 +1,54 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+;;; Vectors are one-dimensional arrays. This means that general array operations
+;;; will work on vectors normally. However, Lisp also defines some functions for
+;;; operating on sequences - which means, either vectors or lists.
+
+(define-test vector-basics
+  ;; #(...) is syntax sugar for defining literal vectors.
+  (let ((vector #(1 11 111)))
+    (true-or-false? t (typep vector 'vector))
+    (assert-equal 11 (aref vector 1))))
+
+(define-test length
+  ;; The function LENGTH works both for vectors and for lists.
+  (assert-equal 3 (length '(1 2 3)))
+  (assert-equal 3 (length #(1 2 3))))
+
+(define-test bit-vector
+  ;; #*0011 defines a bit vector literal with four elements: 0, 0, 1 and 1.
+  (assert-equal #*0011 (make-array 4 :element-type 'bit
+                                     :initial-contents '(0 0 1 1)))
+  (true-or-false? t (typep #*1001 'bit-vector))
+  (assert-equal 0 (aref #*1001 1)))
+
+(define-test bitwise-operations
+  ;; Lisp defines a few bitwise operations that work on bit vectors.
+  (assert-equal #*1000 (bit-and #*1100 #*1010))
+  (assert-equal #*1110 (bit-ior #*1100 #*1010))
+  (assert-equal #*0110 (bit-xor #*1100 #*1010)))
+
+(defun list-to-bit-vector (list)
+  ;; Implement a function that turns a list into a bit vector.
+  (coerce list 'bit-vector))
+
+(define-test list-to-bit-vector
+  ;; You need to fill in the blank in LIST-TO-BIT-VECTOR.
+  (assert-true (typep (list-to-bit-vector '(0 0 1 1 0)) 'bit-vector))
+  (assert-equal (aref (list-to-bit-vector '(0)) 0) 0)
+  (assert-equal (aref (list-to-bit-vector '(0 1)) 1) 1)
+  (assert-equal (length (list-to-bit-vector '(0 0 1 1 0 0 1 1))) 8))
+
+

lisp-koans/koans/arrays.lisp

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

lisp-koans/koans/asserts.lisp

@@ -0,0 +1,65 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+;;;                       ╭╮         ╭╮ ///////
+;;;                       ┃┃         ┃┃///////
+;;;                       ┃┃╭┳━━┳━━╮ ┃┃╭┳━━┳━━┳━╮╭━━╮
+;;;                       ┃┃┣┫━━┫╭╮┃ ┃╰╯┫╭╮┃╭╮┃╭╮┫━━┫
+;;;                       ┃╰┫┣━━┃╰╯┃ ┃╭╮┫╰╯┃╭╮┃┃┃┣━━┃
+;;;                       ╰━┻┻━━┫╭━╯/╰╯╰┻━━┻╯╰┻╯╰┻━━╯
+;;;                             ┃┃ //////
+;;;                             ╰╯//////
+
+;;; Welcome to the Lisp Koans.
+;;; May the code stored here influence your enlightenment as a programmer.
+
+;;; In order to progress, fill in the blanks, denoted via ____ in source code.
+;;; Sometimes, you will be asked to provide values that are equal to something.
+
+(define-test fill-in-the-blanks
+  (assert-equal ____ 2)
+  (assert-equal ____ 3.14)
+  (assert-equal ____ "Hello World"))
+
+;;; Sometimes, you will be asked to say whether something is true or false,
+;;; In Common Lisp, the canonical values for truth and falsehood are T and NIL.
+
+(define-test assert-true
+  (assert-true ____))
+
+(define-test assert-false
+  (assert-false ____))
+
+(define-test true-or-false
+  (true-or-false? ____ (= 34 34))
+  (true-or-false? ____ (= 19 78)))
+
+;;; Since T and NIL are symbols, you can type them in lowercase or uppercase;
+;;; by default, Common Lisp will automatically upcase them upon reading.
+
+(define-test upcase-downcase
+  ;; Try inserting a lowercase t here.
+  (assert-equal ____ T)
+  ;; Try inserting an uppercase NIL here.
+  (assert-equal ____ nil))
+
+;;; Sometimes, you will be asked to provide a part of an expression that must be
+;;; either true or false.
+
+(define-test a-true-assertion
+  (assert-true (= ____ (+ 2 2))))
+
+(define-test a-false-assertion
+  (assert-false (= ____ (+ 2 2))))
+

lisp-koans/koans/atoms-vs-lists.lisp

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

lisp-koans/koans/backquote.lisp

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

lisp-koans/koans/basic-macros.lisp

@@ -0,0 +1,112 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+(define-test setf
+  ;; SETF is a macro used to assign values to places. A place is a concept;
+  ;; it is an abstract "somewhere" where a value is stored.
+  (let ((a 10)
+        (b (list 1 20 30 40 50))
+        ;; We use COPY-SEQ to create a copy of a string, because using SETF to
+        ;; modify literal data (strings, lists, etc.) is undefined behaviour.
+        (c (copy-seq "I am Tom.")))
+    ;; A place may be a variable.
+    (setf a 1000)
+    (assert-equal ____ a)
+    ;; A place may be a part of some list.
+    (setf (first b) 10)
+    (assert-equal ____ b)
+    ;; A place may be a character in a string.
+    ;; The #\x syntax denotes a single character, 'x'.
+    (setf (char c 5) #\B
+          (char c 7) #\b)
+    (assert-equal ____ c)
+    ;; There are other kinds of places that we will explore in the future.
+    ))
+
+(define-test case
+  ;; CASE is a simple pattern-matching macro, not unlike C's "switch".
+  ;; It compares an input against a set of values and evaluates the code for
+  ;; the branch where a match is found.
+  (let* ((a 4)
+         (b (case a
+              (3 :three)
+              (4 :four)
+              (5 :five))))
+    (assert-equal ____ b))
+  ;; CASE can accept a group of keys.
+  (let* ((c 4)
+         (d (case c
+              ((0 2 4 6 8) :even-digit)
+              ((1 3 5 7 9) :odd-digit))))
+    (assert-equal ____ d)))
+
+(defun match-special-cases (thing)
+  ;; T or OTHERWISE passed as the key matches any value.
+  ;; NIL passed as the key matches no values.
+  ;; These symbols need to passed in parentheses.
+  (case thing
+    (____ :found-a-t)
+    (____ :found-a-nil)
+    (____ :something-else)))
+
+(define-test special-cases-of-case
+  ;; You need to fill in the blanks in MATCH-SPECIAL-CASES.
+  (assert-equal :found-a-t (match-special-cases t))
+  (assert-equal :found-a-nil (match-special-cases nil))
+  (assert-equal :something-else (match-special-cases 42)))
+
+(define-test your-own-case-statement
+  ;; We use FLET to define a local function.
+  (flet ((cartoon-dads (input)
+           (case input
+             ;; Fill in the blanks with proper cases.
+             ____
+             ____
+             ____
+             (:this-one-doesnt-happen :fancy-cat)
+             (t :unknown))))
+    (assert-equal (cartoon-dads :bart) :homer)
+    (assert-equal (cartoon-dads :stewie) :peter)
+    (assert-equal (cartoon-dads :stan) :randy)
+    (assert-equal (cartoon-dads :space-ghost) :unknown)))
+
+(define-test limits-of-case
+  ;; So far, we have been comparing objects using EQUAL, one of the Lisp
+  ;; comparison functions. CASE compares the keys using EQL, which is distinct
+  ;; from EQUAL.
+  ;; EQL is suitable for comparing numbers, characters, and objects for whom we
+  ;; want to check verify they are the same object.
+  (let* ((string "A string")
+         (string-copy (copy-seq string)))
+    ;; The above means that two distinct strings will not be the same under EQL,
+    ;; even if they have the same contents.
+    (true-or-false? ____ (eql string string-copy))
+    (true-or-false? ____ (equal string string-copy))
+    ;; The above also means that CASE might give surprising results when used on
+    ;; strings.
+    (let ((match (case string
+                   ("A string" :matched)
+                   (t :not-matched))))
+      (assert-equal ____ match))
+    ;; We will explore this topic further in the EQUALITY-DISTINCTIONS lesson.
+    ))
+
+(define-test cond
+  ;; COND is similar to CASE, except it is more general. It accepts arbitrary
+  ;; conditions and checks them in order until one of them is met.
+  (let* ((number 4)
+         (result (cond ((> number 0) :positive)
+                       ((< number 0) :negative)
+                       (t :zero))))
+    (assert-equal ____ result)))

lisp-koans/koans/clos.lisp

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

lisp-koans/koans/condition-handlers.lisp

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

lisp-koans/koans/control-statements.lisp

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

lisp-koans/koans/dice-project.lisp

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

lisp-koans/koans/equality-distinctions.lisp

@@ -0,0 +1,121 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+;;; The most common equality predicates in Common Lisp are, in order of
+;;; strictness, EQ, EQL, EQUAL, and EQUALP.
+
+(define-test eq
+  ;; EQ checks the identity of the two objects; it checks whether the two
+  ;; objects are, in fact, one and the same object.
+  ;; It is the fastest of the four; however, not guaranteed to work on numbers
+  ;; and characters because of that.
+  (true-or-false? ____ (eq 'a 'a))
+  (true-or-false? ____ (eq 3 3.0))
+  (true-or-false? ____ (eq '(1 2) '(1 2)))
+  (true-or-false? ____ (eq "Foo" "Foo"))
+  (true-or-false? ____ (eq "Foo" (copy-seq "Foo")))
+  (true-or-false? ____ (eq "FOO" "Foo")))
+
+(define-test eql
+  ;; EQL works like EQ, except it is specified to work for numbers and
+  ;; characters.
+  ;; Two numbers are EQL if they are of the same type and represent the same
+  ;; number. Two characters are EQL if they represent the same character.
+  (true-or-false? ____ (eql 'a 'a))
+  (true-or-false? ____ (eql 3 3))
+  (true-or-false? ____ (eql 3 3.0))
+  (true-or-false? ____ (eql '(1 2) '(1 2)))
+  (true-or-false? ____ (eql  '(:a . :b) '(:a . :b)))
+  (true-or-false? ____ (eql #\S #\S))
+  (true-or-false? ____ (eql "Foo" "Foo"))
+  (true-or-false? ____ (eql "Foo" (copy-seq "Foo")))
+  (true-or-false? ____ (eql "FOO" "Foo")))
+
+(define-test equal
+  ;; EQUAL works like EQL, except works differently for lists, strings, bit
+  ;; vectors, and pathnames.
+  ;; Two lists, strings, bit arrays, or pathnames are EQUAL if they have EQUAL
+  ;; elements.
+  (true-or-false? ____ (equal 'a 'a))
+  (true-or-false? ____ (equal 3 3))
+  (true-or-false? ____ (equal 3 3.0))
+  (true-or-false? ____ (equal '(1 2) '(1 2)))
+  (true-or-false? ____ (equal  '(:a . :b) '(:a . :b)))
+  (true-or-false? ____ (equal  '(:a . :b) '(:a . :doesnt-match)))
+  (true-or-false? ____ (equal #\S #\S))
+  (true-or-false? ____ (equal "Foo" "Foo"))
+  (true-or-false? ____ (equal #*01010101 #*01010101))
+  (true-or-false? ____ (equal "Foo" (copy-seq "Foo")))
+  (true-or-false? ____ (equal "FOO" "Foo"))
+  (true-or-false? ____ (equal #p"foo/bar/baz" #p"foo/bar/baz")))
+
+(defstruct thing slot-1 slot-2)
+
+(define-test equalp
+  ;; EQUALP works like EQUAL, except it works differently for characters,
+  ;; numbers, arrays, structures, and hash tables.
+  ;; Two characters are EQUALP if they represent the same character, ignoring
+  ;; the differences in character case.
+  ;; Two numbers are EQUALP if they represent the same number, even if they are
+  ;; of different types.
+  ;; Two arrays are EQUALP if they have the same dimensions and their characters
+  ;; are pairwise EQUALP.
+  ;; Two structures are EQUALP if they are of the same class and their slots are
+  ;; pairwise EQUALP.
+  ;; We will contemplate hash tables in the HASH-TABLES lesson.
+  (true-or-false? ____ (equalp 'a 'a))
+  (true-or-false? ____ (equalp 3 3))
+  (true-or-false? ____ (equalp 3 3.0))
+  (true-or-false? ____ (equalp '(1 2) '(1 2)))
+  (true-or-false? ____ (equalp  '(:a . :b) '(:a . :b)))
+  (true-or-false? ____ (equalp  '(:a . :b) '(:a . :doesnt-match)))
+  (true-or-false? ____ (equalp #\S #\S))
+  (true-or-false? ____ (equalp "Foo" "Foo"))
+  (true-or-false? ____ (equalp "Foo" (copy-seq "Foo")))
+  (true-or-false? ____ (equalp "FOO" "Foo"))
+  (true-or-false? ____ (equalp (make-array '(4 2) :initial-element 0)
+                               (make-array '(4 2) :initial-element 0)))
+  (true-or-false? ____ (equalp (make-thing :slot-1 42 :slot-2 :forty-two)
+                               (make-thing :slot-1 42 :slot-2 :forty-two))))
+
+;;; In additional to the generic equality predicates, Lisp also provides
+;;; type-specific predicates for numbers, strings, and characters.
+
+(define-test =
+  ;; The function = behaves just like EQUALP on numbers.
+  ;; #C(... ...) is syntax sugar for creating a complex number.
+  (true-or-false? ____ (= 99.0 99 99.000 #C(99 0) #C(99.0 0.0)))
+  (true-or-false? ____ (= 0 1 -1))
+  (true-or-false? ____ (= (/ 2 3) (/ 6 9) (/ 86 129))))
+
+(define-test string=
+  ;; The function STRING= behaves just like EQUAL on strings.
+  ;; The function STRING-EQUAL behaves just like EQUALP on strings.
+  (true-or-false? ____ (string= "Foo" "Foo"))
+  (true-or-false? ____ (string= "Foo" "FOO"))
+  (true-or-false? ____ (string-equal "Foo" "FOO"))
+  ;; These functions accept additional keyword arguments that allow one to
+  ;; only compare parts of the strings.
+  (true-or-false? ____ (string= "together" "frog" :start1 1 :end1 3
+                                                  :start2 2))
+  (true-or-false? ____ (string-equal "together" "FROG" :start1 1 :end1 3
+                                                       :start2 2)))
+
+(define-test char=
+  ;; The function CHAR= behaves just like EQL on characters.
+  ;; The function CHAR-EQUAL behaves just like EQUALP on characters.
+  (true-or-false? ____ (char= #\A (char "ABCDEF" 0)))
+  (true-or-false? ____ (char= #\A #\a))
+  (true-or-false? ____ (char-equal #\A (char "ABCDEF" 0)))
+  (true-or-false? ____ (char-equal #\A #\a)))

lisp-koans/koans/evaluation.lisp

@@ -0,0 +1,66 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+;;; In most imperative languages, the syntax of a function call has the function
+;;; name succeeded by a list of arguments. In Lisp, the function name and
+;;; arguments are all part of the same list, with the function name the first
+;;; element of that list.
+
+(define-test function-names
+  ;; In these examples, +, -, *, and / are function names.
+  (assert-equal ____ (+ 2 3))
+  (assert-equal ____ (- 1 3))
+  (assert-equal ____ (* 7 4))
+  (assert-equal ____ (/ 100 4)))
+
+(define-test numberp
+  ;; NUMBERP is a predicate which returns true if its argument is a number.
+  (assert-equal ____ (numberp 5))
+  (assert-equal ____ (numberp 2.0))
+  (assert-equal ____ (numberp "five")))
+
+(define-test evaluation-order
+  ;; Arguments to a function are evaluated before the function is called.
+  (assert-equal ____ (* (+ 1 2) (- 13 10))))
+
+(define-test basic-comparisons
+  ;; The below functions are boolean functions (predicates) that operate on
+  ;; numbers.
+  (assert-equal ____ (> 25 4))
+  (assert-equal ____ (< 8 2))
+  (assert-equal ____ (= 3 3))
+  (assert-equal ____ (<= 6 (/ 12 2)))
+  (assert-equal ____ (>= 20 (+ 1 2 3 4 5)))
+  (assert-equal ____ (/= 15 (+ 4 10))))
+
+(define-test quote
+  ;; Preceding a list with a quote (') will tell Lisp not to evaluate a list.
+  ;; The quote special form suppresses normal evaluation, and instead returns
+  ;; the literal list.
+  ;; Evaluating the form (+ 1 2) returns the number 3, but evaluating the form
+  ;; '(+ 1 2) returns the list (+ 1 2).
+  (assert-equal ____ (+ 1 2))
+  (assert-equal ____ '(+ 1 2))
+  (assert-equal ____ (list '+ 1 2))
+  ;; The 'X syntax is syntactic sugar for (QUOTE X).
+  (true-or-false? ____ (equal '(/ 4 0) (quote (/ 4 0)))))
+
+(define-test listp
+  ;; LISTP is a predicate which returns true if the argument is a list.
+  (assert-equal ____ (listp '(1 2 3)))
+  (assert-equal ____ (listp 100))
+  (assert-equal ____ (listp "Hello world"))
+  (assert-equal ____ (listp nil))
+  (assert-equal ____ (listp (+ 1 2)))
+  (assert-equal ____ (listp '(+ 1 2))))

lisp-koans/koans/extra-credit.lisp

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

lisp-koans/koans/extra-credit.txt

@@ -0,0 +1,66 @@
+= Playing Greed
+
+Greed is a dice game played among 2 or more players, using 5
+six-sided dice.
+
+== Playing Greed
+
+Each player takes a turn consisting of one or more rolls of the dice.
+On the first roll of the game, a player rolls all five dice which are
+scored according to the following:
+
+  Three 1's => 1000 points
+  Three 6's =>  600 points
+  Three 5's =>  500 points
+  Three 4's =>  400 points
+  Three 3's =>  300 points
+  Three 2's =>  200 points
+  One   1   =>  100 points
+  One   5   =>   50 points
+
+A single die can only be counted once in each roll.  For example,
+a "5" can only count as part of a triplet (contributing to the 500
+points) or as a single 50 points, but not both in the same roll.
+
+Example Scoring
+
+   Throw       Score
+   ---------   ------------------
+   5 1 3 4 1   50 + 2 * 100 = 250
+   1 1 1 3 1   1000 + 100 = 1100
+   2 4 4 5 4   400 + 50 = 450
+
+The dice not contributing to the score are called the non-scoring
+dice.  "3" and "4" are non-scoring dice in the first example.  "3" is
+a non-scoring die in the second, and "2" is a non-score die in the
+final example.
+
+After a player rolls and the score is calculated, the scoring dice are
+removed and the player has the option of rolling again using only the
+non-scoring dice. If all of the thrown dice are scoring, then the
+player may roll all 5 dice in the next roll.
+
+The player may continue to roll as long as each roll scores points. If
+a roll has zero points, then the player loses not only their turn, but
+also accumulated score for that turn. If a player decides to stop
+rolling before rolling a zero-point roll, then the accumulated points
+for the turn is added to his total score.
+
+== Getting "In The Game"
+
+Before a player is allowed to accumulate points, they must get at
+least 300 points in a single turn. Once they have achieved 300 points
+in a single turn, the points earned in that turn and each following
+turn will be counted toward their total score.
+
+== End Game
+
+Once a player reaches 3000 (or more) points, the game enters the final
+round where each of the other players gets one more turn. The winner
+is the player with the highest score after the final round.
+
+== References
+
+Greed is described on Wikipedia at
+http://en.wikipedia.org/wiki/Greed_(dice_game), however the rules are
+a bit different from the rules given here.

lisp-koans/koans/format.lisp

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

lisp-koans/koans/functions.lisp

@@ -0,0 +1,180 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+(defun some-named-function (a b)
+  (+ a b))
+
+(define-test call-a-function
+  ;; DEFUN can be used to define global functions.
+  (assert-equal ____ (some-named-function 4 5))
+  ;; FLET can be used to define local functions.
+  (flet ((another-named-function (a b) (* a b)))
+    (assert-equal ____ (another-named-function 4 5)))
+  ;; LABELS can be used to define local functions which can refer to themselves
+  ;; or each other.
+  (labels ((recursive-function (a b)
+             (if (or (= 0 a) (= 0 b))
+                 1
+                 (+ (* a b) (recursive-function (1- a) (1- b))))))
+    (assert-equal ____ (recursive-function 4 5))))
+
+(define-test shadow-a-function
+  (assert-eq 18 (some-named-function 7 11))
+  ;; FLET and LABELS can shadow function definitions.
+  (flet ((some-named-function (a b) (* a b)))
+    (assert-equal ____ (some-named-function 7 11)))
+  (assert-equal ____ (some-named-function 7 11)))
+
+(defun function-with-optional-parameters (&optional (a 2) (b 3) c)
+  ;; If an optional argument to a function is not provided, it is given its
+  ;; default value, or NIL, if no default value is specified.
+  (list a b c))
+
+(define-test optional-parameters
+  (assert-equal ____ (function-with-optional-parameters 42 24 4224))
+  (assert-equal ____ (function-with-optional-parameters 42 24))
+  (assert-equal ____ (function-with-optional-parameters 42))
+  (assert-equal ____ (function-with-optional-parameters)))
+
+(defun function-with-optional-indication
+    (&optional (a 2 a-provided-p) (b 3 b-provided-p))
+  ;; It is possible to check whether an optional argument was provided.
+  (list a a-provided-p b b-provided-p))
+
+(define-test optional-indication
+  (assert-equal ____ (function-with-optional-indication 42 24))
+  (assert-equal ____ (function-with-optional-indication 42))
+  (assert-equal ____ (function-with-optional-indication)))
+
+(defun function-with-rest-parameter (&rest x)
+  ;; A rest parameter gathers all remaining parameters in a list.
+  x)
+
+(define-test rest-parameter
+  (assert-equal ____ (function-with-rest-parameter))
+  (assert-equal ____ (function-with-rest-parameter 1))
+  (assert-equal ____ (function-with-rest-parameter 1 :two 333)))
+
+(defun function-with-keyword-parameters (&key (a :something) b c)
+  ;; A keyword parameters is similar to an optional parameter, but is provided
+  ;; by a keyword-value pair.
+  (list a b c))
+
+(define-test keyword-parameters ()
+  (assert-equal ____ (function-with-keyword-parameters))
+  (assert-equal ____ (function-with-keyword-parameters :a 11 :b 22 :c 33))
+  ;; It is not necessary to specify all keyword parameters.
+  (assert-equal ____ (function-with-keyword-parameters :b 22))
+  ;; Keyword argument order is not important.
+  (assert-equal ____ (function-with-keyword-parameters :b 22 :c -5/2 :a 0))
+  ;; Lisp handles duplicate keyword parameters.
+  (assert-equal ____ (function-with-keyword-parameters :b 22 :b 40 :b 812)))
+
+(defun function-with-keyword-indication
+    (&key (a 2 a-provided-p) (b 3 b-provided-p))
+  ;; It is possible to check whether a keyword argument was provided.
+  (list a a-provided-p b b-provided-p))
+
+(define-test keyword-indication
+  (assert-equal ____ (function-with-keyword-indication))
+  (assert-equal ____ (function-with-keyword-indication :a 3 :b 4))
+  (assert-equal ____ (function-with-keyword-indication :a 11 :b 22))
+  (assert-equal ____ (function-with-keyword-indication :b 22))
+  (assert-equal ____ (function-with-keyword-indication :b 22 :a 0)))
+
+(defun function-with-funky-parameters (a &rest x &key b (c a c-provided-p))
+  ;; Lisp functions can have surprisingly complex lambda lists.
+  ;; A &rest parameter must come before &key parameters.
+  (list a b c c-provided-p x))
+
+(define-test funky-parameters
+  (assert-equal ____ (function-with-funky-parameters 1))
+  (assert-equal ____ (function-with-funky-parameters 1 :b 2))
+  (assert-equal ____ (function-with-funky-parameters 1 :b 2 :c 3))
+  (assert-equal ____ (function-with-funky-parameters 1 :c 3 :b 2)))
+
+(define-test lambda
+  ;; A list form starting with the symbol LAMBDA denotes an anonymous function.
+  ;; It is possible to call that function immediately or to store it for later
+  ;; use.
+  (let ((my-function (lambda (a b) (* a b))))
+    (assert-equal ____ (funcall my-function 11 9)))
+  ;; A LAMBDA form is allowed to take the place of a function name.
+  (assert-equal ____ ((lambda (a b) (+ a b)) 10 9))
+  (let ((functions (list (lambda (a b) (+ a b))
+                         (lambda (a b) (- a b))
+                         (lambda (a b) (* a b))
+                         (lambda (a b) (/ a b)))))
+    (assert-equal ____ (funcall (first functions) 2 33))
+    (assert-equal ____ (funcall (second functions) 2 33))
+    (assert-equal ____ (funcall (third functions) 2 33))
+    (assert-equal ____ (funcall (fourth functions) 2 33))))
+
+(define-test lambda-with-optional-parameters
+  (assert-equal ____ ((lambda (a &optional (b 100)) (+ a b)) 10 9))
+  (assert-equal ____ ((lambda (a &optional (b 100)) (+ a b)) 10)))
+
+(defun make-adder (x)
+  ;; MAKE-ADDER will create a function that closes over the parameter X.
+  ;; The parameter will be remembered as a part of the environment of the
+  ;; returned function, which will continue refering to it.
+  (lambda (y) (+ x y)))
+
+(define-test lexical-closures
+  (let ((adder-100 (make-adder 100))
+        (adder-500 (make-adder 500)))
+    ;; ADD-100 and ADD-500 now close over different values.
+    (assert-equal ____ (funcall adder-100 3))
+    (assert-equal ____ (funcall adder-500 3))))
+
+(defun make-reader-and-writer (x)
+  ;; Both returned functions will refer to the same place.
+  (list (function (lambda () x))
+        (function (lambda (y) (setq x y)))))
+
+(define-test lexical-closure-interactions
+  ;; The macro DESTRUCTURING-BIND is like LET, except it binds the variables
+  ;; listed in its first argument to the parts of the list returned by the form
+  ;; that is its second argument.
+  (destructuring-bind (reader-1 writer-1) (make-reader-and-writer 1)
+    (destructuring-bind (reader-2 writer-2) (make-reader-and-writer :one)
+      (assert-equal ____ (funcall reader-1))
+      (funcall writer-1 0)
+      (assert-equal ____ (funcall reader-1))
+      ;; The two different function pairs refer to different places.
+      (assert-equal ____ (funcall reader-2))
+      (funcall writer-2 :zero)
+      (assert-equal ____ (funcall reader-2)))))
+
+(define-test apply
+  ;; The function APPLY applies a function to a list of arguments.
+  (let ((function (lambda (x y z) (+ x y z))))
+    (assert-equal ____ (apply function '(100 20 3))))
+  ;; FUNCTION is a special operator that retrieves function objects, defined
+  ;; both globally and locally. #'X is syntax sugar for (FUNCTION X).
+  (assert-equal ____ (apply (function +) '(1 2)))
+  (assert-equal ____ (apply #'- '(1 2)))
+  ;; Only the last argument to APPLY must be a list.
+  (assert-equal ____ (apply #'+ 1 2 '(3)))
+  (assert-equal ____ (apply #'max 1 2 3 4 '())))
+
+(define-test funcall
+  ;; The function FUNCALL calls a function with arguments, not expecting a final
+  ;; list of arguments.
+  (let ((function (lambda (x y z) (+ x y z))))
+    (assert-equal ____ (funcall function 300 20 1)))
+  (assert-equal ____ (funcall (function +) 1 2))
+  (assert-equal ____ (funcall #'- 1 2))
+  (assert-equal ____ (funcall #'+ 1 2 3))
+  (assert-equal ____ (funcall #'max 1 2 3 4)))

lisp-koans/koans/hash-tables.lisp

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

lisp-koans/koans/iteration.lisp

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

lisp-koans/koans/let.lisp

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

lisp-koans/koans/lists.lisp

@@ -0,0 +1,146 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+;;; A singly linked list is the basic build block of Lisp. Each node of such a
+;;; list is called a "cons cell" in Lisp. Each cons cell has two slots: a CAR,
+;;; often used to hold an element of a list, and a CDR, often used to reference
+;;; the next cons cell.
+
+(define-test how-to-make-lists
+  (let (;; Literal lists can be passed by quoting them.
+        (fruits '(orange pomello clementine))
+        ;; Freshly constructed lists can be passed using the LIST function.
+        (some-evens (list (* 2 1) (* 2 2) (* 2 3)))
+        ;; Lists can also be passed using quotes and dot notation...
+        (long-numbers '(16487302 . (3826700034 . (10000000 . nil))))
+        ;; ...or by using the function CONS.
+        (names (cons "Matthew" (cons "Mark" (cons "Margaret" '())))))
+    ;; Try filling in the below blanks in different ways.
+    (assert-equal ____ fruits)
+    (assert-equal ____ some-evens)
+    (assert-equal ____ long-numbers)
+    (assert-equal ____ names)))
+
+(define-test cons-tructing-lists
+  ;; The function CONS can be used to add new elements at the beginning of
+  ;; an existing list.
+  (let ((nums '()))
+    (setf nums (cons :one nums))
+    (assert-equal ____ nums)
+    (setf nums (cons :two nums))
+    (assert-equal ____ nums)
+    ;; Lists can contain anything, even objects of different types.
+    (setf nums (cons 333 nums))
+    (assert-equal ____ nums)
+    ;; Lists can contain other lists, too.
+    (setf nums (cons (list "some" "strings") nums))
+    (assert-equal ____ nums)))
+
+(define-test car-and-cdr
+  ;; We may use functions CAR and CDR (or, alternatively, FIRST and REST) to
+  ;; access the two slots of a cons cell.
+  (let ((x (cons 1 2)))
+    (assert-equal ____ (car x))
+    (assert-equal ____ (cdr x)))
+  ;; Calls to CAR and CDR are often intertwined to extract data from a nested
+  ;; cons structure.
+  (let ((structure '((1 2) (("foo" . "bar")))))
+    (assert-equal ____ (car structure))
+    (assert-equal ____ (car (cdr structure)))
+    (assert-equal ____ (cdr (car (car (cdr structure)))))
+    ;; Lisp defines shorthand functions for up to four such nested calls.
+    (assert-equal ____ (car structure))
+    (assert-equal ____ (cadr structure))
+    (assert-equal ____ (cdaadr structure))))
+
+(define-test push-pop
+  ;; PUSH and POP are macros similar to SETF, as both of them operate on places.
+  (let ((place '(10 20 30 40)))
+    ;; PUSH sets the value of the place to a new cons cell containing some value
+    ;; in its CAR.
+    (push 0 place)
+    (assert-equal ____ place)
+    ;; POP removes a single cons cell from a place, sets the place to its CDR,
+    ;; and returns the value from its CAR.
+    (let ((value (pop place)))
+      (assert-equal ____ value)
+      (assert-equal ____ place))
+    ;; The return value of POP can be discarded to simply "remove" a single cons
+    ;; cell from a place.
+    (pop place)
+    (let ((value (pop place)))
+      (assert-equal ____ value)
+      (assert-equal ____ place))))
+
+(define-test append-nconc
+  ;; The functions APPEND and NCONC appends one list to the end of another.
+  ;; While APPEND creates new lists, NCONC modifies existing ones; therefore
+  ;; APPEND can be used on literals, but NCONC needs fresh lists.
+  (assert-equal ____ (append '(:a :b) '(:c)))
+  (assert-equal ____ (nconc (list :a :b) (list :c)))
+  (let ((list-1 (list 1 2 3))
+        (list-2 (list 4 5 6)))
+    ;; Both APPEND and NCONC return the appended list, but the interesting part
+    ;; is what happens when we try to use the original variables passed to them.
+    (assert-equal ____ (append list-1 list-2))
+    (assert-equal ____ list-1)
+    (assert-equal ____ list-2)
+    (assert-equal ____ (nconc list-1 list-2))
+    (assert-equal ____ list-1)
+    (assert-equal ____ list-2)))
+
+(define-test accessing-list-elements
+  (let ((noms '("peanut" "butter" "and" "jelly")))
+    ;; Common Lisp defines accessor functions for lists: FIRST, SECOND, ...,
+    ;; up to TENTH.
+    (assert-equal "peanut" (first noms))
+    (assert-equal ____ (second noms))
+    (assert-equal ____ (fourth noms))
+    ;; The function LAST returns the last cons cell of a list.
+    (assert-equal ____ (last noms))
+    ;; The function NTH returns the n-th element of a list.
+    (assert-equal "butter" (nth 1 noms))
+    (assert-equal ____ (nth 0 noms))
+    (assert-equal ____ (nth 3 noms))))
+
+(define-test cons-tructing-improper-lists
+  ;; A proper list is a list whose final CDR ends with NIL.
+  ;; An improper list either has a non-NIL value in its final CDR or does not
+  ;; have a final CDR due to a cycle in its structure.
+  (let (;; We can construct non-cyclic improper lists using LIST*...
+        (x (list* 1 2 3 4 5))
+        ;; ...or pass them as literals via dot notation.
+        (y '(6 7 8 9 . 0)))
+    (assert-equal ____ (last x))
+    (assert-equal ____ (last y)))
+  ;; We can create a cyclic list by changing the last CDR of a list to refer to
+  ;; another cons cell
+  (let ((list (list 1 2 3 4 5))
+        (cyclic-list (list 1 2 3 4 5)))
+    (setf (cdr (last cyclic-list)) cyclic-list)
+    ;; Function LIST-LENGTH returns NIL if a list is cyclic.
+    (assert-equal ____ (list-length list))
+    (assert-equal ____ (list-length cyclic-list))
+    ;; Many Lisp functions operate only on proper lists.
+    ;; The function NTH is not one of them; it can be used to retrieve elements
+    ;; of cyclic lists.
+    (assert-equal ____ (nth 101 cyclic-list))))
+
+(define-test slicing-lists
+  ;; The function SUBSEQ returns a subsequence of a list.
+  (let ((noms (list "peanut" "butter" "and" "jelly")))
+    (assert-equal ____ (subseq noms 0 1))
+    (assert-equal ____ (subseq noms 0 2))
+    (assert-equal ____ (subseq noms 2 2))
+    (assert-equal ____ (subseq noms 2))))

lisp-koans/koans/loops.lisp

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

lisp-koans/koans/macros.lisp

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

lisp-koans/koans/mapcar-and-reduce.lisp

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

lisp-koans/koans/multiple-values.lisp

@@ -0,0 +1,41 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+;;; In Lisp, it is possible for a function to return more than one value.
+;;; This is distinct from returning a list or structure of values.
+
+(define-test multiple-values
+  (let ((x (floor 3/2))
+        ;; The macro MULTIPLE-VALUE-LIST returns a list of all values returned
+        ;; by a Lisp form.
+        (y (multiple-value-list (floor 3/2))))
+    (assert-equal x 1)
+    (assert-equal y '(1 1/2)))
+  (assert-equal ____ (multiple-value-list (floor 99/4))))
+
+(defun next-fib (a b)
+  ;; The function VALUES allows returning multiple values.
+  (values b (+ a b)))
+
+(define-test binding-and-setting-multiple-values
+  ;; The macro MULTIPLE-VALUE-BIND is like LET, except it binds the variables
+  ;; listed in its first argument to the values returned by the form that is its
+  ;; second argument.
+  (multiple-value-bind (x y) (next-fib 3 5)
+    (let ((result (* x y)))
+      (assert-equal ____ result)))
+  ;; SETF can also set multiple values if a VALUES form is provided as a place.
+  (let (x y)
+    (setf (values x y) (next-fib 5 8))
+    (assert-equal ____ (list x y))))

lisp-koans/koans/nil-false-empty.lisp

@@ -0,0 +1,52 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+(define-test t-and-nil-are-opposites
+  ;; NOT is a function which returns the boolean opposite of its argument.
+  (true-or-false? ____ (not nil))
+  (true-or-false? ____ (not t)))
+
+(define-test nil-and-empty-list-are-the-same-thing
+  ;; In Common Lisp, NIL is also the empty list.
+  (true-or-false? ____ '())
+  (true-or-false? ____ (not '())))
+
+(define-test in-lisp-many-things-are-true
+  ;; In Common Lisp, the canonical values for truth is T.
+  ;; However, everything that is non-NIL is true, too.
+  (true-or-false? ____ 5)
+  (true-or-false? ____ (not 5))
+  (true-or-false? ____ "a string")
+  ;; Even an empty string...
+  (true-or-false? ____ "")
+  ;; ...or a list containing a NIL...
+  (true-or-false? ____ (list nil))
+  ;; ...or an array with no elements...
+  (true-or-false? ____ (make-array 0))
+  ;; ...or the number zero.
+  (true-or-false? ____ 0))
+
+(define-test and
+  ;; The logical operator AND can take multiple arguments.
+  (true-or-false? ____ (and t t t t t))
+  (true-or-false? ____ (and t t nil t t))
+  ;; If all values passed to AND are true, it returns the last value.
+  (assert-equal ____ (and t t t t t 5)))
+
+(define-test or
+  ;; The logical operator OR can also take multiple arguments.
+  (true-or-false? ____  (or nil nil nil t nil))
+  ;; OR returns the first non-NIL value it encounters, or NIL if there are none.
+  (assert-equal ____ (or nil nil nil))
+  (assert-equal ____ (or 1 2 3 4 5)))

lisp-koans/koans/scope-and-extent.lisp

@@ -0,0 +1,48 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+(define-test shadowing
+  (assert-equal ____ (let ((z 4)) (list z (let ((z 2)) z)))))
+
+(defun block-1 ()
+  (block here
+    (return-from here 4)
+    5))
+
+(defun block-2 ()
+  (block outer
+    (block inner
+      (return-from outer 'space)
+      (return-from inner 'tube))
+    (return-from outer 'valve)))
+
+(define-test block-return-from
+  (assert-equal ____ (block-1))
+  (assert-equal ____ (block-2)))
+
+;;; See http://www.gigamonkeys.com/book/variables.html
+
+(define-test lexical-variables-can-be-enclosed
+  (assert-equal ____ (let ((f (let ((x 10))
+                                (lambda () x))))
+                       (let ((x 20))
+                         (funcall f)))))
+
+(define-test dynamic-variables-are-affected-by-execution-path
+  (assert-equal ____ (let ((f (let ((x 10))
+                                (declare (special x))
+                                (lambda () x))))
+                       (let ((x 20))
+                         (declare (special x))
+                         (funcall f)))))

lisp-koans/koans/scoring-project.lisp

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

lisp-koans/koans/std-method-comb.lisp

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

lisp-koans/koans/strings.lisp

@@ -0,0 +1,73 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+(define-test what-is-a-string
+  (let ((string "Do, or do not. There is no try."))
+    (true-or-false? ____ (typep string 'string))
+    ;; Strings are vectors of characters.
+    (true-or-false? ____ (typep string 'array))
+    (true-or-false? ____ (typep string 'vector))
+    (true-or-false? ____ (typep string '(vector character)))
+    (true-or-false? ____ (typep string 'integer))))
+
+(define-test multiline-string
+  ;; A Lisp string can span multiple lines.
+  (let ((string "this is
+                 a multi
+                 line string"))
+    (true-or-false? ____ (typep string 'string))))
+
+(define-test escapes-in-strings
+  ;; Quotes and backslashes in Lisp strings must be escaped.
+  (let ((my-string "this string has one of these \" and a \\ in it"))
+    (true-or-false? ____ (typep my-string 'string))))
+
+(define-test substrings
+  ;; Since strings are sequences, it is possible to use SUBSEQ on them.
+  (let ((string "Lorem ipsum dolor sit amet"))
+    (assert-equal ____ (subseq string 12))
+    (assert-equal ____ (subseq string 6 11))
+    (assert-equal ____ (subseq string 1 5))))
+
+(define-test strings-versus-characters
+  ;; Strings and characters have distinct types.
+  (true-or-false? ____ (typep #\a 'character))
+  (true-or-false? ____ (typep "A" 'character))
+  (true-or-false? ____ (typep #\a 'string))
+  ;; One can use both AREF and CHAR to refer to characters in a string.
+  (let ((my-string "Cookie Monster"))
+    (assert-equal ____ (char my-string 0))
+    (assert-equal ____ (char my-string 3))
+    (assert-equal ____ (aref my-string 7))))
+
+(define-test concatenating-strings
+  ;; Concatenating strings in Common Lisp is possible, if a little cumbersome.
+  (let ((a "Lorem")
+        (b "ipsum")
+        (c "dolor"))
+    (assert-equal ____ (concatenate 'string a " " b " " c))))
+
+(define-test searching-for-characters
+  ;; The function POSITION can be used to find the first position of an element
+  ;; in a sequence. If the element is not found, NIL is returned.
+  (assert-equal ____ (position #\b "abc"))
+  (assert-equal ____ (position #\c "abc"))
+  (assert-equal ____ (position #\d "abc")))
+
+(define-test finding-substrings
+  ;; The function SEARCH can be used to search a sequence for subsequences.
+  (let ((title "A supposedly fun thing I'll never do again"))
+    (assert-equal ____ (search "supposedly" title))
+    (assert-equal 12 (search ____ title))))
+

lisp-koans/koans/structures.lisp

@@ -0,0 +1,111 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+;;; Lisp structures encapsulate data which belongs together. They are a template
+;;; of sorts, providing a way to generate multiple instances of uniformly
+;;; organized information
+;;; Defining a structure also interns accessor functions to get and set the
+;;; slots of that structure.
+
+;;; The following form creates a new structure class named BASKETBALL-PLAYER
+;;; with slots named NAME, TEAM, and NUMBER.
+;;; This additionally creates functions MAKE-BASKETBALL-PLAYER,
+;;; COPY-BASKETBALL-PLAYER, BASKETBALL-PLAYER-P, BASKETBALL-PLAYER-NAME,
+;;; BASKETBALL-PLAYER-TEAM, and BASKETBALL-PLAYER-NUMBER.
+
+(defstruct basketball-player
+  name team number)
+
+(define-test make-struct
+  (let ((player (make-basketball-player :name "Larry" :team :celtics
+                                        :number 33)))
+    (true-or-false? ____ (basketball-player-p player))
+    (assert-equal ____ (basketball-player-name player))
+    (assert-equal ____ (basketball-player-team player))
+    (assert-equal ____ (basketball-player-number player))
+    (setf (basketball-player-team player) :retired)
+    (assert-equal ____ (basketball-player-team player))))
+
+;;; Structure fields can have default values.
+
+(defstruct baseball-player
+  name (team :red-sox) (position :outfield))
+
+(define-test struct-defaults
+  (let ((player (make-baseball-player)))
+    ;; We have not specified a default value for NAME, therefore we cannot
+    ;; read it here - it would invoke undefined behaviour.
+    (assert-equal ____ (baseball-player-team player))
+    (assert-equal ____ (baseball-player-position player))))
+
+;;; The accessor names can get pretty long. It's possible to specify a different
+;;; prefix with the :CONC-NAME option.
+
+(defstruct (american-football-player (:conc-name nfl-guy-))
+  name position team)
+
+(define-test struct-access
+  (let ((player (make-american-football-player
+                 :name "Drew Brees" :position :qb :team "Saints")))
+    (assert-equal ____ (nfl-guy-name player))
+    (assert-equal ____ (nfl-guy-team player))
+    (assert-equal ____ (nfl-guy-position player))))
+
+;;; Structs can be defined to include other structure definitions.
+;;; This form of inheritance allows composition of objects.
+
+(defstruct (nba-contract (:include basketball-player))
+  salary start-year end-year)
+
+(define-test structure-inheritance
+  (let ((contract (make-nba-contract :salary 136000000
+                                     :start-year 2004 :end-year 2011
+                                     :name "Kobe Bryant"
+                                     :team :lakers :number 24)))
+    (assert-equal ____ (nba-contract-start-year contract))
+    (assert-equal ____ (type-of contract))
+    ;; Inherited structures follow the rules of type hierarchy.
+    (true-or-false? ____ (typep contract 'basketball-player))
+    ;; One can access structure fields both with the structure's own accessors
+    ;; and with the inherited accessors.
+    (assert-equal ____ (nba-contract-team contract))
+    (assert-equal ____ (basketball-player-team contract))))
+
+;;; Copying a structure named FOO is handled with the COPY-FOO function.
+;;; All such copies are shallow.
+
+(define-test structure-equality-and-copying
+  (let ((manning-1 (make-american-football-player
+                    :name "Manning" :team (list "Colts" "Broncos")))
+        (manning-2 (make-american-football-player
+                    :name "Manning" :team (list "Colts" "Broncos"))))
+    ;; MANNING-1 and MANNING-2 are different objects...
+    (true-or-false? ____ (eq manning-1 manning-2))
+    ;;...but they contain the same information.
+    (true-or-false? ____ (equalp manning-1 manning-2))
+    (let ((manning-3 (copy-american-football-player manning-1)))
+      (true-or-false? ____ (eq manning-1 manning-3))
+      (true-or-false? ____ (equalp manning-1 manning-3))
+      ;; Setting the slot of one instance does not modify the others...
+      (setf (nfl-guy-name manning-1) "Rogers")
+      (true-or-false? ____ (string= (nfl-guy-name manning-1)
+                                    (nfl-guy-name manning-3)))
+      (assert-equal ____ (nfl-guy-name manning-1))
+      (assert-equal ____ (nfl-guy-name manning-3))
+      ;; ...but modifying shared structure may affect other instances.
+      (setf (car (nfl-guy-team manning-1)) "Giants")
+      (true-or-false? ____ (string= (car (nfl-guy-team manning-1))
+                                    (car (nfl-guy-team manning-3))))
+      (assert-equal ____ (car (nfl-guy-team manning-1)))
+      (assert-equal ____ (car (nfl-guy-team manning-3))))))

lisp-koans/koans/threads.lisp

@@ -0,0 +1,161 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+;;; This lesson group uses Quicklisp to load Bordeaux Threads, a portability
+;;; library for working with threads. This is because threads are not a part of
+;;; the Common Lisp standard and implementations do them differently.
+;;; If you are using Quicklisp, please feel free to enable this lesson by
+;;; following the instructions in the README.
+
+;;; TODO: wait for Bordeaux Threads to implement a portable SEMAPHORE-COUNT
+;;; and use it in the semaphore koans.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-test thread-return-value
+  ;; When a thread object is constructed, it accepts a function to execute.
+  (let* ((thread (bt:make-thread (lambda () (+ 2 2))))
+         ;; When the thread's function finishes, its return value becomes the
+         ;; return value of BT:JOIN-THREAD.
+         (value (bt:join-thread thread)))
+    (assert-equal ____ value)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar *variable*)
+
+(define-test thread-global-bindings
+  ;; The global value of a variable is shared between all threads.
+  (setf *variable* 42)
+  (let ((thread (bt:make-thread (lambda ()
+                                  (when (= *variable* 42)
+                                    (setf *variable* 24)
+                                    t)))))
+    (assert-true (bt:join-thread thread))
+    (assert-equal ____ *variable*)))
+
+(define-test thread-local-bindings
+  ;; Newly established local bindings of a variable are visible only in the
+  ;; thread that established these bindings.
+  (setf *variable* 42)
+  (let ((thread (bt:make-thread (lambda ()
+                                  (let ((*variable* 42))
+                                    (setf *variable* 24))))))
+    (bt:join-thread thread)
+    (assert-equal ____ *variable*)))
+
+(define-test thread-initial-bindings
+  ;; Initial dynamic bindings may be passed to the new thread.
+  (setf *variable* 42)
+  (let ((thread (bt:make-thread (lambda () (setf *variable* 24))
+                                :initial-bindings '((*variable* . 42)))))
+    (bt:join-thread thread)
+    (assert-equal ____ *variable*)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-test thread-name
+  ;; Threads can have names.
+  (let ((thread (bt:make-thread #'+ :name "Summing thread")))
+    (assert-equal ____ (bt:thread-name thread))
+    (assert-equal ____ (bt:join-thread thread))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-test thread-function-arguments
+  ;; Passing arguments to thread functions requires closing over them.
+  (let* ((x 240)
+         (y 18)
+         (thread (bt:make-thread (lambda () (* x y)))))
+    (assert-equal ____ (bt:join-thread thread))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-test destroy-thread
+  ;; Looping and renegade threads can usually be killed via BT:DESTROY-THREAD.
+  ;; It is the last measure, since doing so might leave the Lisp system in an
+  ;; unpredictable state if the thread was doing something complex.
+  (let ((thread (bt:make-thread (lambda () (loop (sleep 1))))))
+    (true-or-false? ____ (bt:thread-alive-p thread))
+    (bt:destroy-thread thread)
+    (true-or-false? ____ (bt:thread-alive-p thread))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar *another-variable*)
+
+;; Preventing concurrent access to some data can be achieved via a lock in
+;; order to avoid race conditions.
+
+(defvar *lock* (bt:make-lock))
+
+(define-test lock
+  (setf *another-variable* 0)
+  (flet ((increaser () (bt:with-lock-held (*lock*) (incf *another-variable*))))
+    (loop repeat 100
+          collect (bt:make-thread #'increaser) into threads
+          finally (loop until (notany #'bt:thread-alive-p threads))
+                  (assert-equal ____ *another-variable*))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; We can further orchestrate threads by using semaphores.
+
+(defvar *semaphore* (bt:make-semaphore))
+
+(defun signal-our-semaphore ()
+  (bt:signal-semaphore semaphore))
+
+(defun wait-on-our-semaphore ()
+  (bt:wait-on-semaphore semaphore :timeout 100))
+
+(define-test semaphore
+  (assert-equal 1 (bt:join-thread (bt:make-thread #'signal-our-semaphore)))
+  (assert-equal ____ (bt:join-thread (bt:make-thread #'signal-our-semaphore)))
+  (assert-equal ____ (bt:join-thread (bt:make-thread #'signal-our-semaphore)))
+  (assert-equal 2 (bt:join-thread (bt:make-thread #'wait-on-our-semaphore)))
+  (assert-equal ____ (bt:join-thread (bt:make-thread #'wait-on-our-semaphore)))
+  (assert-equal ____ (bt:join-thread (bt:make-thread #'wait-on-our-semaphore)))
+  (assert-equal ____ (bt:join-thread (bt:make-thread #'wait-on-our-semaphore))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Semaphores can be used to manage resource allocation and to trigger some
+;; threads to run when the semaphore value is above zero.
+
+(defvar *foobar-semaphore* (bt:make-semaphore))
+
+(defvar *foobar-list*)
+
+(defun bar-pusher ()
+  (dotimes (i 10)
+    (sleep 0.01)
+    (push i (nth i *foobar-list*))
+    (push :bar (nth i *foobar-list*))
+    ;; We push :BAR before :FOO, so the final list looks like (:FOO :BAR).
+    (bt:signal-semaphore *foobar-semaphore*)))
+
+(defun foo-pusher ()
+  (dotimes (i 10)
+    (bt:wait-on-semaphore *foobar-semaphore*)
+    (push :foo (nth i *foobar-list*))))
+
+(define-test list-of-foobars
+  (setf *foobar-list* (make-list 10))
+  (let ((bar-pusher (bt:make-thread #'bar-pusher))
+        (foo-pusher (bt:make-thread #'foo-pusher)))
+    (bt:join-thread foo-pusher))
+  (assert-equal ____ (nth 0 *foobar-list*))
+  (assert-equal ____ (nth 1 *foobar-list*))
+  (assert-equal ____ (nth 5 *foobar-list*)))

lisp-koans/koans/triangle-project.lisp

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

lisp-koans/koans/type-checking.lisp

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

lisp-koans/koans/variables-parameters-constants.lisp

@@ -0,0 +1,88 @@
+;;   Copyright 2013 Google Inc.
+;;
+;;   Licensed under the Apache License, Version 2.0 (the "License");
+;;   you may not use this file except in compliance with the License.
+;;   You may obtain a copy of the License at
+;;
+;;       http://www.apache.org/licenses/LICENSE-2.0
+;;
+;;   Unless required by applicable law or agreed to in writing, software
+;;   distributed under the License is distributed on an "AS IS" BASIS,
+;;   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;   See the License for the specific language governing permissions and
+;;   limitations under the License.
+
+(defun test-variable-assignment-with-setf ()
+  ;; the let pattern allows us to create local variables with
+  ;; lexical scope.
+  (let (var_name_1 (var_name_2 "Michael"))
+  ;; variables may be defined with or without initial values.
+  (and
+   (equalp var_name_2 "Michael")
+   ; new values may be assigned to variables with setf
+   (setf var_name_2 "Janet")
+   (equalp var_name_2 "Janet")
+   ; setf may assign multiple variables in one form.
+   (setf var_name_1 "Tito"
+         var_name_2 "Jermaine")
+   (equalp var_name_1 "Tito")
+   (equalp var_name_2 "Jermaine"))))
+
+(defun test-setf-for-lists ()
+  ;; setf also works on list elements
+  (let (l)
+    (setf l '(1 2 3))
+    (equalp l '(1 2 3))
+    ; First second and third are convenient accessor functions
+    ; referring to the elements of a list
+    ; For those interested, they are convenient to car, cadr, and caddr
+    (setf (first l) 10)
+    (setf (second l) 20)
+    (setf (third l) 30)
+    (equalp l '(10 20 30))))
+
+(defparameter param_name_1 "Janet")
+; defparameter requires an initial form.  It is a compiler error to exclude it
+;(defparameter param_no_init)  ;; this will fail
+(defconstant additive_identity 0)
+; defconstant also requires an initial form
+; (defconstant constant_no_init)
+
+; reassigning parameters to new values is also ok, but parameters carry the
+; connotation of immutability.  If it's going to change frequently, it should
+; be a var.
+(setf param_name_1 "The other one")
+
+; reassigning a constant is an error.
+; this should result in a compile time error
+; (setf additive_identity -1)
+
+
+;; -------------------------------
+;; below is necessary to run tests.
+;; -------------------------------
+
+(defvar failed-test-names nil)
+
+(defun run-test (testfun)
+  (let ((fun-name (function-name testfun)))
+    (if (apply testfun '())
+        (format t ".")
+        (progn
+          (setf failed-test-names (cons fun-name failed-test-names))
+          (format t "F")))))
+
+(defun function-name (function) (nth-value 2 (function-lambda-expression function)))
+
+
+(run-test #'test-variable-assignment-with-setf)
+(run-test #'test-setf-for-lists)
+
+(format t "~%")
+
+(defun report-failure (test-name)
+  (format t "~S failed.~%" test-name))
+
+(if (endp failed-test-names)  ; no failed tests
+    (format t "all tests pass.~%")
+    (mapcar #'report-failure failed-test-names))

lisp-koans/koans/vectors.lisp

@@ -0,0 +1,53 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+;;; Vectors are one-dimensional arrays. This means that general array operations
+;;; will work on vectors normally. However, Lisp also defines some functions for
+;;; operating on sequences - which means, either vectors or lists.
+
+(define-test vector-basics
+  ;; #(...) is syntax sugar for defining literal vectors.
+  (let ((vector #(1 11 111)))
+    (true-or-false? ____ (typep vector 'vector))
+    (assert-equal ____ (aref vector 1))))
+
+(define-test length
+  ;; The function LENGTH works both for vectors and for lists.
+  (assert-equal ____ (length '(1 2 3)))
+  (assert-equal ____ (length #(1 2 3))))
+
+(define-test bit-vector
+  ;; #*0011 defines a bit vector literal with four elements: 0, 0, 1 and 1.
+  (assert-equal #*0011 (make-array 4 :element-type 'bit :initial-contents ____))
+  (true-or-false? ____ (typep #*1001 'bit-vector))
+  (assert-equal ____ (aref #*1001 1)))
+
+(define-test bitwise-operations
+  ;; Lisp defines a few bitwise operations that work on bit vectors.
+  (assert-equal ____ (bit-and #*1100 #*1010))
+  (assert-equal ____ (bit-ior #*1100 #*1010))
+  (assert-equal ____ (bit-xor #*1100 #*1010)))
+
+(defun list-to-bit-vector (list)
+  ;; Implement a function that turns a list into a bit vector.
+  ____)
+
+(define-test list-to-bit-vector
+  ;; You need to fill in the blank in LIST-TO-BIT-VECTOR.
+  (assert-true (typep (list-to-bit-vector '(0 0 1 1 0)) 'bit-vector))
+  (assert-equal (aref (list-to-bit-vector '(0)) 0) 0)
+  (assert-equal (aref (list-to-bit-vector '(0 1)) 1) 1)
+  (assert-equal (length (list-to-bit-vector '(0 0 1 1 0 0 1 1))) 8))
+
+

lisp-koans/lisp-koans.lisp

@@ -0,0 +1,133 @@
+;;; Copyright 2013 Google Inc.
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;     http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+(defpackage #:lisp-koans.core
+  (:use #:common-lisp
+        #:lisp-koans.test)
+  (:export #:main))
+
+(in-package :lisp-koans.core)
+
+(defvar *all-koan-groups*
+  (with-open-file (in #p".koans")
+    (with-standard-io-syntax (read in))))
+
+(defvar *collected-results* nil)
+
+;;; Functions for loading koans
+
+(defun package-name-from-group-name (group-name)
+  (format nil "LISP-KOANS.KOANS.~A" group-name))
+
+(defun load-koan-group-named (dirname koan-group-name)
+  (let* ((koan-name (string-downcase (string koan-group-name)))
+         (koan-file-name (concatenate 'string koan-name ".lisp"))
+         (koan-package-name (package-name-from-group-name koan-group-name)))
+    (unless (find-package koan-package-name)
+      (make-package koan-package-name
+                    :use '(#:common-lisp #:lisp-koans.test)))
+    (let ((*package* (find-package koan-package-name)))
+      (load (concatenate 'string dirname "/" koan-file-name)))))
+
+(defun load-all-koans (dirname)
+  (loop for koan-group-name in *all-koan-groups*
+        do (load-koan-group-named dirname koan-group-name)))
+
+;;; Functions for executing koans
+
+(defun execute-koans ()
+  (loop for koan-group-name in *all-koan-groups*
+        for package-name = (package-name-from-group-name koan-group-name)
+        for kg-results = (run-koans package-name)
+        collect (list koan-group-name kg-results) into results
+        do (print-koan-group-progress koan-group-name kg-results)
+        while (every (lambda (x) (eq x :pass)) (second (first kg-results)))
+        finally (setf *collected-results* results)))
+
+;;; Functions for printing progress
+
+(defun print-koan-group-progress (name results)
+  (format t "~%Thinking about ~A~%" name)
+  (dolist (result (reverse results))
+    (destructuring-bind (test-name results) result
+      (let ((format-control (if (every (lambda (x) (equalp :pass x)) results)
+                                "    ~A has expanded your awareness.~%"
+                                "    ~A requires more meditation.~%")))
+        (format t format-control test-name)))))
+
+;;; Functions for processing results
+
+(defun n-passed-koans-overall (collected-results)
+  (flet ((all-asserts-passed-in-koan-p (result)
+           (every (lambda (x) (eq :pass x)) (second result))))
+    (loop for kg in collected-results
+          sum (count-if #'all-asserts-passed-in-koan-p (second kg)))))
+
+(defun any-assert-non-pass-p ()
+  (dolist (k-group-result *collected-results*)
+    (dolist (result (second k-group-result))
+      (dolist (one-assert (second result))
+        (when (not (equal one-assert :pass))
+          (return-from any-assert-non-pass-p one-assert))))))
+
+;;; Functions for printing results
+
+(defun koan-status-message (koan-status)
+  (cond ((find :incomplete koan-status) "A koan is incomplete.")
+        ((find :fail koan-status) "A koan is incorrect.")
+        ((find :error koan-status) "A koan signaled an error.")
+        (t (format nil "Last koan status: ~A." koan-status))))
+
+(defun print-next-suggestion-message (dirname)
+  (let ((filename (caar (last *collected-results*)))
+        (koan-name (caaadr (car (last (last *collected-results*)))))
+        (koan-status (reverse (cadaar (cdar (last (last *collected-results*)))))))
+    (format t "~&You have not yet reached enlightenment.
+    ~A
+Please meditate on the following code:
+    File \"~A/~(~A~).lisp\"
+    Koan \"~A\"
+    Current koan assert status is \"~A\"~%~%"
+            (koan-status-message koan-status) dirname filename koan-name koan-status)))
+
+(defun print-completion-message ()
+  (format t "
+*********************************************************
+That was the last one, well done! ENLIGHTENMENT IS YOURS!
+*********************************************************
+
+If you demand greater challenge, take a look at extra-credit.lisp
+Or, let the student become the teacher:
+Write and submit your own improvements to https://github.com/google/lisp-koans!~%
+"))
+
+(defun print-progress-message ()
+  (format t "You are now ~A/~A koans and ~A/~A lessons closer to reaching enlightenment.~%~%"
+          (n-passed-koans-overall *collected-results*)
+          (test-total-count)
+          (1- (length *collected-results*))
+          (length *all-koan-groups*)))
+
+(defun output-advice (dirname)
+  (cond ((any-assert-non-pass-p)
+         (print-next-suggestion-message dirname)
+         (print-progress-message))
+        (t (print-completion-message))))
+
+;;; Main
+
+(defun main (&optional (dirname "koans"))
+  (load-all-koans dirname)
+  (execute-koans)
+  (output-advice dirname))