diff --git a/flake.nix b/flake.nix index c5cd437..0371d15 100644 --- a/flake.nix +++ b/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 ]; }; } ); diff --git a/lisp-koans/.git_bak/HEAD b/lisp-koans/.git_bak/HEAD new file mode 100644 index 0000000..cb089cd --- /dev/null +++ b/lisp-koans/.git_bak/HEAD @@ -0,0 +1 @@ +ref: refs/heads/master diff --git a/lisp-koans/.git_bak/config b/lisp-koans/.git_bak/config new file mode 100644 index 0000000..bd2d2c1 --- /dev/null +++ b/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 diff --git a/lisp-koans/.git_bak/description b/lisp-koans/.git_bak/description new file mode 100644 index 0000000..498b267 --- /dev/null +++ b/lisp-koans/.git_bak/description @@ -0,0 +1 @@ +Unnamed repository; edit this file 'description' to name the repository. diff --git a/lisp-koans/.git_bak/hooks/applypatch-msg.sample b/lisp-koans/.git_bak/hooks/applypatch-msg.sample new file mode 100755 index 0000000..8cae14b --- /dev/null +++ b/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+"$@"} +: diff --git a/lisp-koans/.git_bak/hooks/commit-msg.sample b/lisp-koans/.git_bak/hooks/commit-msg.sample new file mode 100755 index 0000000..0d82a6f --- /dev/null +++ b/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 +} diff --git a/lisp-koans/.git_bak/hooks/fsmonitor-watchman.sample b/lisp-koans/.git_bak/hooks/fsmonitor-watchman.sample new file mode 100755 index 0000000..fe8af19 --- /dev/null +++ b/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 $/; }; + + # 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; +} diff --git a/lisp-koans/.git_bak/hooks/post-update.sample b/lisp-koans/.git_bak/hooks/post-update.sample new file mode 100755 index 0000000..2fb1286 --- /dev/null +++ b/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 diff --git a/lisp-koans/.git_bak/hooks/pre-applypatch.sample b/lisp-koans/.git_bak/hooks/pre-applypatch.sample new file mode 100755 index 0000000..8669075 --- /dev/null +++ b/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+"$@"} +: diff --git a/lisp-koans/.git_bak/hooks/pre-commit.sample b/lisp-koans/.git_bak/hooks/pre-commit.sample new file mode 100755 index 0000000..a9d0607 --- /dev/null +++ b/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 -- diff --git a/lisp-koans/.git_bak/hooks/pre-merge-commit.sample b/lisp-koans/.git_bak/hooks/pre-merge-commit.sample new file mode 100755 index 0000000..53c9717 --- /dev/null +++ b/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" +: diff --git a/lisp-koans/.git_bak/hooks/pre-push.sample b/lisp-koans/.git_bak/hooks/pre-push.sample new file mode 100755 index 0000000..1547904 --- /dev/null +++ b/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: +# +# +# +# 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 &2 "Found WIP commit in $local_ref, not pushing" + exit 1 + fi + fi +done + +exit 0 diff --git a/lisp-koans/.git_bak/hooks/pre-rebase.sample b/lisp-koans/.git_bak/hooks/pre-rebase.sample new file mode 100755 index 0000000..7dc9db1 --- /dev/null +++ b/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 diff --git a/lisp-koans/.git_bak/hooks/pre-receive.sample b/lisp-koans/.git_bak/hooks/pre-receive.sample new file mode 100755 index 0000000..8102dd3 --- /dev/null +++ b/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 diff --git a/lisp-koans/.git_bak/hooks/prepare-commit-msg.sample b/lisp-koans/.git_bak/hooks/prepare-commit-msg.sample new file mode 100755 index 0000000..4ce547b --- /dev/null +++ b/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 diff --git a/lisp-koans/.git_bak/hooks/push-to-checkout.sample b/lisp-koans/.git_bak/hooks/push-to-checkout.sample new file mode 100755 index 0000000..7aaf394 --- /dev/null +++ b/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 &2 + echo " (if you want, you could supply GIT_DIR then run" >&2 + echo " $0 )" >&2 + exit 1 +fi + +if [ -z "$refname" -o -z "$oldrev" -o -z "$newrev" ]; then + echo "usage: $0 " >&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 &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 diff --git a/lisp-koans/.git_bak/index b/lisp-koans/.git_bak/index new file mode 100644 index 0000000..51152ba Binary files /dev/null and b/lisp-koans/.git_bak/index differ diff --git a/lisp-koans/.git_bak/info/exclude b/lisp-koans/.git_bak/info/exclude new file mode 100644 index 0000000..a5196d1 --- /dev/null +++ b/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] +# *~ diff --git a/lisp-koans/.git_bak/logs/HEAD b/lisp-koans/.git_bak/logs/HEAD new file mode 100644 index 0000000..63d03a1 --- /dev/null +++ b/lisp-koans/.git_bak/logs/HEAD @@ -0,0 +1 @@ +0000000000000000000000000000000000000000 fa286eb6a98b0ab463c9c6da97b3113220d34216 efim 1658664650 +0000 clone: from https://github.com/google/lisp-koans.git diff --git a/lisp-koans/.git_bak/logs/refs/heads/master b/lisp-koans/.git_bak/logs/refs/heads/master new file mode 100644 index 0000000..63d03a1 --- /dev/null +++ b/lisp-koans/.git_bak/logs/refs/heads/master @@ -0,0 +1 @@ +0000000000000000000000000000000000000000 fa286eb6a98b0ab463c9c6da97b3113220d34216 efim 1658664650 +0000 clone: from https://github.com/google/lisp-koans.git diff --git a/lisp-koans/.git_bak/objects/pack/pack-8c2896a3a8da8460db9e347142b231d6e1a43972.idx b/lisp-koans/.git_bak/objects/pack/pack-8c2896a3a8da8460db9e347142b231d6e1a43972.idx new file mode 100644 index 0000000..28bc868 Binary files /dev/null and b/lisp-koans/.git_bak/objects/pack/pack-8c2896a3a8da8460db9e347142b231d6e1a43972.idx differ diff --git a/lisp-koans/.git_bak/objects/pack/pack-8c2896a3a8da8460db9e347142b231d6e1a43972.pack b/lisp-koans/.git_bak/objects/pack/pack-8c2896a3a8da8460db9e347142b231d6e1a43972.pack new file mode 100644 index 0000000..3799b4c Binary files /dev/null and b/lisp-koans/.git_bak/objects/pack/pack-8c2896a3a8da8460db9e347142b231d6e1a43972.pack differ diff --git a/lisp-koans/.git_bak/packed-refs b/lisp-koans/.git_bak/packed-refs new file mode 100644 index 0000000..e658a5b --- /dev/null +++ b/lisp-koans/.git_bak/packed-refs @@ -0,0 +1,2 @@ +# pack-refs with: peeled fully-peeled sorted +fa286eb6a98b0ab463c9c6da97b3113220d34216 refs/remotes/origin/master diff --git a/lisp-koans/.git_bak/refs/heads/master b/lisp-koans/.git_bak/refs/heads/master new file mode 100644 index 0000000..fb8f018 --- /dev/null +++ b/lisp-koans/.git_bak/refs/heads/master @@ -0,0 +1 @@ +fa286eb6a98b0ab463c9c6da97b3113220d34216 diff --git a/lisp-koans/.koans b/lisp-koans/.koans new file mode 100644 index 0000000..89d6da5 --- /dev/null +++ b/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 + ) diff --git a/lisp-koans/BUILD b/lisp-koans/BUILD new file mode 100644 index 0000000..bf87c5f --- /dev/null +++ b/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"]) diff --git a/lisp-koans/LICENSE b/lisp-koans/LICENSE new file mode 100644 index 0000000..bf2f833 --- /dev/null +++ b/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. diff --git a/lisp-koans/README.md b/lisp-koans/README.md new file mode 100644 index 0000000..14de991 --- /dev/null +++ b/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. diff --git a/lisp-koans/TODO b/lisp-koans/TODO new file mode 100644 index 0000000..88cddc7 --- /dev/null +++ b/lisp-koans/TODO @@ -0,0 +1 @@ +* improve error reporting from "a koan signaled an error" to something more helpful diff --git a/lisp-koans/contemplate.lisp b/lisp-koans/contemplate.lisp new file mode 100644 index 0000000..c9ec921 --- /dev/null +++ b/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) diff --git a/lisp-koans/koans-solved/arrays.lisp b/lisp-koans/koans-solved/arrays.lisp new file mode 100644 index 0000000..2aaf886 --- /dev/null +++ b/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)))) diff --git a/lisp-koans/koans-solved/asserts.lisp b/lisp-koans/koans-solved/asserts.lisp new file mode 100644 index 0000000..d3a7f29 --- /dev/null +++ b/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)))) + diff --git a/lisp-koans/koans-solved/atoms-vs-lists.lisp b/lisp-koans/koans-solved/atoms-vs-lists.lisp new file mode 100644 index 0000000..ef1c2fe --- /dev/null +++ b/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))) diff --git a/lisp-koans/koans-solved/backquote.lisp b/lisp-koans/koans-solved/backquote.lisp new file mode 100644 index 0000000..e1a187d --- /dev/null +++ b/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)))) diff --git a/lisp-koans/koans-solved/basic-macros.lisp b/lisp-koans/koans-solved/basic-macros.lisp new file mode 100644 index 0000000..dc6caba --- /dev/null +++ b/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))) diff --git a/lisp-koans/koans-solved/clos.lisp b/lisp-koans/koans-solved/clos.lisp new file mode 100644 index 0000000..25a37a6 --- /dev/null +++ b/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)))) diff --git a/lisp-koans/koans-solved/condition-handlers.lisp b/lisp-koans/koans-solved/condition-handlers.lisp new file mode 100644 index 0000000..7d7bee1 --- /dev/null +++ b/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))))) diff --git a/lisp-koans/koans-solved/control-statements.lisp b/lisp-koans/koans-solved/control-statements.lisp new file mode 100644 index 0000000..48b73a1 --- /dev/null +++ b/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))) diff --git a/lisp-koans/koans-solved/dice-project.lisp b/lisp-koans/koans-solved/dice-project.lisp new file mode 100644 index 0000000..e73ef66 --- /dev/null +++ b/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))))) diff --git a/lisp-koans/koans-solved/equality-distinctions.lisp b/lisp-koans/koans-solved/equality-distinctions.lisp new file mode 100644 index 0000000..becd702 --- /dev/null +++ b/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))) diff --git a/lisp-koans/koans-solved/evaluation.lisp b/lisp-koans/koans-solved/evaluation.lisp new file mode 100644 index 0000000..709f3e0 --- /dev/null +++ b/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)))) diff --git a/lisp-koans/koans-solved/extra-credit.lisp b/lisp-koans/koans-solved/extra-credit.lisp new file mode 100644 index 0000000..4e51c5d --- /dev/null +++ b/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)) diff --git a/lisp-koans/koans-solved/extra-credit.txt b/lisp-koans/koans-solved/extra-credit.txt new file mode 100644 index 0000000..58b5a9c --- /dev/null +++ b/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. diff --git a/lisp-koans/koans-solved/format.lisp b/lisp-koans/koans-solved/format.lisp new file mode 100644 index 0000000..7297b31 --- /dev/null +++ b/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"))) diff --git a/lisp-koans/koans-solved/functions.lisp b/lisp-koans/koans-solved/functions.lisp new file mode 100644 index 0000000..2b757aa --- /dev/null +++ b/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))) diff --git a/lisp-koans/koans-solved/hash-tables.lisp b/lisp-koans/koans-solved/hash-tables.lisp new file mode 100644 index 0000000..febaaec --- /dev/null +++ b/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)))))) diff --git a/lisp-koans/koans-solved/iteration.lisp b/lisp-koans/koans-solved/iteration.lisp new file mode 100644 index 0000000..65338f4 --- /dev/null +++ b/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. + ) + diff --git a/lisp-koans/koans-solved/let.lisp b/lisp-koans/koans-solved/let.lisp new file mode 100644 index 0000000..778e907 --- /dev/null +++ b/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)))))) diff --git a/lisp-koans/koans-solved/lists.lisp b/lisp-koans/koans-solved/lists.lisp new file mode 100644 index 0000000..95e1678 --- /dev/null +++ b/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)))) diff --git a/lisp-koans/koans-solved/loops.lisp b/lisp-koans/koans-solved/loops.lisp new file mode 100644 index 0000000..ad3ae1f --- /dev/null +++ b/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))))) diff --git a/lisp-koans/koans-solved/macros.lisp b/lisp-koans/koans-solved/macros.lisp new file mode 100644 index 0000000..74a7c70 --- /dev/null +++ b/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))))) diff --git a/lisp-koans/koans-solved/mapcar-and-reduce.lisp b/lisp-koans/koans-solved/mapcar-and-reduce.lisp new file mode 100644 index 0000000..5774347 --- /dev/null +++ b/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))))) diff --git a/lisp-koans/koans-solved/multiple-values.lisp b/lisp-koans/koans-solved/multiple-values.lisp new file mode 100644 index 0000000..511368d --- /dev/null +++ b/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)))) diff --git a/lisp-koans/koans-solved/nil-false-empty.lisp b/lisp-koans/koans-solved/nil-false-empty.lisp new file mode 100644 index 0000000..ebbd6eb --- /dev/null +++ b/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))) diff --git a/lisp-koans/koans-solved/scope-and-extent.lisp b/lisp-koans/koans-solved/scope-and-extent.lisp new file mode 100644 index 0000000..16c0aa6 --- /dev/null +++ b/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))))) diff --git a/lisp-koans/koans-solved/scoring-project.lisp b/lisp-koans/koans-solved/scoring-project.lisp new file mode 100644 index 0000000..9cb34ff --- /dev/null +++ b/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))) diff --git a/lisp-koans/koans-solved/std-method-comb.lisp b/lisp-koans/koans-solved/std-method-comb.lisp new file mode 100644 index 0000000..2dbd6ab --- /dev/null +++ b/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)))) diff --git a/lisp-koans/koans-solved/strings.lisp b/lisp-koans/koans-solved/strings.lisp new file mode 100644 index 0000000..87a57eb --- /dev/null +++ b/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)))) + diff --git a/lisp-koans/koans-solved/structures.lisp b/lisp-koans/koans-solved/structures.lisp new file mode 100644 index 0000000..362eddb --- /dev/null +++ b/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)))))) diff --git a/lisp-koans/koans-solved/threads.lisp b/lisp-koans/koans-solved/threads.lisp new file mode 100644 index 0000000..318e39f --- /dev/null +++ b/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*))) diff --git a/lisp-koans/koans-solved/triangle-project.lisp b/lisp-koans/koans-solved/triangle-project.lisp new file mode 100644 index 0000000..b19f9f6 --- /dev/null +++ b/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))))) diff --git a/lisp-koans/koans-solved/type-checking.lisp b/lisp-koans/koans-solved/type-checking.lisp new file mode 100644 index 0000000..8afb5e2 --- /dev/null +++ b/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)))) diff --git a/lisp-koans/koans-solved/variables-parameters-constants.lisp b/lisp-koans/koans-solved/variables-parameters-constants.lisp new file mode 100644 index 0000000..ca96037 --- /dev/null +++ b/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)) \ No newline at end of file diff --git a/lisp-koans/koans-solved/vectors.lisp b/lisp-koans/koans-solved/vectors.lisp new file mode 100644 index 0000000..32b4eec --- /dev/null +++ b/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)) + + diff --git a/lisp-koans/koans/arrays.lisp b/lisp-koans/koans/arrays.lisp new file mode 100644 index 0000000..3b1c642 --- /dev/null +++ b/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)))) diff --git a/lisp-koans/koans/asserts.lisp b/lisp-koans/koans/asserts.lisp new file mode 100644 index 0000000..8093e15 --- /dev/null +++ b/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)))) + diff --git a/lisp-koans/koans/atoms-vs-lists.lisp b/lisp-koans/koans/atoms-vs-lists.lisp new file mode 100644 index 0000000..62de29f --- /dev/null +++ b/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))) diff --git a/lisp-koans/koans/backquote.lisp b/lisp-koans/koans/backquote.lisp new file mode 100644 index 0000000..c66deba --- /dev/null +++ b/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)))) diff --git a/lisp-koans/koans/basic-macros.lisp b/lisp-koans/koans/basic-macros.lisp new file mode 100644 index 0000000..d5b14c9 --- /dev/null +++ b/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))) diff --git a/lisp-koans/koans/clos.lisp b/lisp-koans/koans/clos.lisp new file mode 100644 index 0000000..44822d6 --- /dev/null +++ b/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)))) diff --git a/lisp-koans/koans/condition-handlers.lisp b/lisp-koans/koans/condition-handlers.lisp new file mode 100644 index 0000000..c18d1d6 --- /dev/null +++ b/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))))) diff --git a/lisp-koans/koans/control-statements.lisp b/lisp-koans/koans/control-statements.lisp new file mode 100644 index 0000000..13ba43b --- /dev/null +++ b/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))) diff --git a/lisp-koans/koans/dice-project.lisp b/lisp-koans/koans/dice-project.lisp new file mode 100644 index 0000000..d48f72b --- /dev/null +++ b/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))))) diff --git a/lisp-koans/koans/equality-distinctions.lisp b/lisp-koans/koans/equality-distinctions.lisp new file mode 100644 index 0000000..4bfb72a --- /dev/null +++ b/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))) diff --git a/lisp-koans/koans/evaluation.lisp b/lisp-koans/koans/evaluation.lisp new file mode 100644 index 0000000..ef0e7a5 --- /dev/null +++ b/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)))) diff --git a/lisp-koans/koans/extra-credit.lisp b/lisp-koans/koans/extra-credit.lisp new file mode 100644 index 0000000..2bd62be --- /dev/null +++ b/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 ____)) diff --git a/lisp-koans/koans/extra-credit.txt b/lisp-koans/koans/extra-credit.txt new file mode 100644 index 0000000..58b5a9c --- /dev/null +++ b/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. diff --git a/lisp-koans/koans/format.lisp b/lisp-koans/koans/format.lisp new file mode 100644 index 0000000..39d0e6f --- /dev/null +++ b/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"))) diff --git a/lisp-koans/koans/functions.lisp b/lisp-koans/koans/functions.lisp new file mode 100644 index 0000000..cf67ffc --- /dev/null +++ b/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))) diff --git a/lisp-koans/koans/hash-tables.lisp b/lisp-koans/koans/hash-tables.lisp new file mode 100644 index 0000000..35ffb5e --- /dev/null +++ b/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)))))) diff --git a/lisp-koans/koans/iteration.lisp b/lisp-koans/koans/iteration.lisp new file mode 100644 index 0000000..5268a3b --- /dev/null +++ b/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. + ) + diff --git a/lisp-koans/koans/let.lisp b/lisp-koans/koans/let.lisp new file mode 100644 index 0000000..4f9b08e --- /dev/null +++ b/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)))))) diff --git a/lisp-koans/koans/lists.lisp b/lisp-koans/koans/lists.lisp new file mode 100644 index 0000000..4ed0946 --- /dev/null +++ b/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)))) diff --git a/lisp-koans/koans/loops.lisp b/lisp-koans/koans/loops.lisp new file mode 100644 index 0000000..02d7e8b --- /dev/null +++ b/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))))) diff --git a/lisp-koans/koans/macros.lisp b/lisp-koans/koans/macros.lisp new file mode 100644 index 0000000..8541513 --- /dev/null +++ b/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))))) diff --git a/lisp-koans/koans/mapcar-and-reduce.lisp b/lisp-koans/koans/mapcar-and-reduce.lisp new file mode 100644 index 0000000..76dfa83 --- /dev/null +++ b/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))))) diff --git a/lisp-koans/koans/multiple-values.lisp b/lisp-koans/koans/multiple-values.lisp new file mode 100644 index 0000000..5459c0a --- /dev/null +++ b/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)))) diff --git a/lisp-koans/koans/nil-false-empty.lisp b/lisp-koans/koans/nil-false-empty.lisp new file mode 100644 index 0000000..6d4dd41 --- /dev/null +++ b/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))) diff --git a/lisp-koans/koans/scope-and-extent.lisp b/lisp-koans/koans/scope-and-extent.lisp new file mode 100644 index 0000000..7b5ae1b --- /dev/null +++ b/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))))) diff --git a/lisp-koans/koans/scoring-project.lisp b/lisp-koans/koans/scoring-project.lisp new file mode 100644 index 0000000..33aea48 --- /dev/null +++ b/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))) diff --git a/lisp-koans/koans/std-method-comb.lisp b/lisp-koans/koans/std-method-comb.lisp new file mode 100644 index 0000000..c05862c --- /dev/null +++ b/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)))) diff --git a/lisp-koans/koans/strings.lisp b/lisp-koans/koans/strings.lisp new file mode 100644 index 0000000..dcf8850 --- /dev/null +++ b/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)))) + diff --git a/lisp-koans/koans/structures.lisp b/lisp-koans/koans/structures.lisp new file mode 100644 index 0000000..42f88ef --- /dev/null +++ b/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)))))) diff --git a/lisp-koans/koans/threads.lisp b/lisp-koans/koans/threads.lisp new file mode 100644 index 0000000..318e39f --- /dev/null +++ b/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*))) diff --git a/lisp-koans/koans/triangle-project.lisp b/lisp-koans/koans/triangle-project.lisp new file mode 100644 index 0000000..a08da93 --- /dev/null +++ b/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))))) diff --git a/lisp-koans/koans/type-checking.lisp b/lisp-koans/koans/type-checking.lisp new file mode 100644 index 0000000..09a3b14 --- /dev/null +++ b/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)))) diff --git a/lisp-koans/koans/variables-parameters-constants.lisp b/lisp-koans/koans/variables-parameters-constants.lisp new file mode 100644 index 0000000..ca96037 --- /dev/null +++ b/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)) \ No newline at end of file diff --git a/lisp-koans/koans/vectors.lisp b/lisp-koans/koans/vectors.lisp new file mode 100644 index 0000000..70cb0b0 --- /dev/null +++ b/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)) + + diff --git a/lisp-koans/lisp-koans.lisp b/lisp-koans/lisp-koans.lisp new file mode 100644 index 0000000..f7c5366 --- /dev/null +++ b/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)) diff --git a/lisp-koans/meditate-linux.sh b/lisp-koans/meditate-linux.sh new file mode 100644 index 0000000..1a81132 --- /dev/null +++ b/lisp-koans/meditate-linux.sh @@ -0,0 +1,44 @@ +#!/bin/bash + +if [ $# != 1 ]; then + echo "usage: sh meditate.sh " + echo " lisp implementation: one of abcl, ccl, clisp, ecl, or sbcl" + exit +fi + +choose_command_line() { + case "$1" in + 'abcl' ) + echo "abcl --noinform --noinit --load contemplate.lisp --eval '(quit)'" + ;; + 'ccl' ) + echo "ccl -n -l contemplate.lisp -e '(quit)'" + ;; + 'clisp' ) + echo "clisp -q -norc -ansi contemplate.lisp" + ;; + 'ecl' ) + echo "ecl -norc -load contemplate.lisp -eval '(quit)'" + ;; + 'sbcl' ) + echo "sbcl --script contemplate.lisp" + ;; + * ) + echo "" + exit + ;; + esac +} + +CONTEMPLATE=$(choose_command_line $1) +if [ "$CONTEMPLATE" = "" ]; then + echo "Unknown Lisp implementation." + exit +else + echo $CONTEMPLATE +fi + +$CONTEMPLATE +while inotifywait -e modify --exclude "\#.*\#" -q -r koans; do + $CONTEMPLATE +done diff --git a/lisp-koans/meditate-macos.sh b/lisp-koans/meditate-macos.sh new file mode 100644 index 0000000..dbaaeab --- /dev/null +++ b/lisp-koans/meditate-macos.sh @@ -0,0 +1,44 @@ +#!/bin/sh + +if [ $# != 1 ]; then + echo "usage: sh meditate.sh " + echo " lisp implementation: one of abcl, ccl, clisp, ecl, or sbcl" + exit +fi + +choose_command_line() { + case "$1" in + 'abcl' ) + echo "abcl --noinform --noinit --load contemplate.lisp --eval '(quit)'" + ;; + 'ccl' ) + echo "ccl -n -l contemplate.lisp -e '(quit)'" + ;; + 'clisp' ) + echo "clisp -q -norc -ansi contemplate.lisp" + ;; + 'ecl' ) + echo "ecl -norc -load contemplate.lisp -eval '(quit)'" + ;; + 'sbcl' ) + echo "sbcl --script contemplate.lisp" + ;; + * ) + echo "" + exit + ;; + esac +} + +CONTEMPLATE=$(choose_command_line $1) +if [ "$CONTEMPLATE" = "" ]; then + echo "Unknown Lisp implementation." + exit +else + echo $CONTEMPLATE +fi + +$CONTEMPLATE +while fswatch --exclude '#.*#' -r1 koans | grep .; do + $CONTEMPLATE +done diff --git a/lisp-koans/test-framework.lisp b/lisp-koans/test-framework.lisp new file mode 100644 index 0000000..8ef1904 --- /dev/null +++ b/lisp-koans/test-framework.lisp @@ -0,0 +1,182 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; Copyright (c) 2004-2005 Christopher K. Riesbeck +;;; +;;; Permission is hereby granted, free of charge, to any person obtaining +;;; a copy of this software and associated documentation files (the "Software"), +;;; to deal in the Software without restriction, including without limitation +;;; the rights to use, copy, modify, merge, publish, distribute, sublicense, +;;; and/or sell copies of the Software, and to permit persons to whom the +;;; Software is furnished to do so, subject to the following conditions: +;;; +;;; The above copyright notice and this permission notice shall be included +;;; in all copies or substantial portions of the Software. +;;; +;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +;;; OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +;;; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR +;;; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, +;;; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +;;; OTHER DEALINGS IN THE SOFTWARE. + +;;; This version of testing framework is based on LISP-UNIT, extended +;;; to support the lisp koans. Specifically, it is an unnamed branch from +;;; https://github.com/OdonataResearchLLC/lisp-unit/ +;;; with hash 93d07b2fa6e32364916225f6218e9e7313027c1f +;;; +;;; Modifications were made to: +;;; 1) Support incomplete tests in addition to passing and failing ones +;;; 2) End test execution at the first non-passing test +;;; 3) Remove all dead code unrelated to lisp-koans +;;; 4) Rename the system to not collide with the original LISP-UNIT. + +;;; Packages +(defpackage #:lisp-koans.test + (:use #:common-lisp) + ;; Assertions + (:export #:assert-eq #:assert-eql #:assert-equal #:assert-equalp #:true-or-false? + #:assert-expands #:assert-true #:assert-false #:assert-error) + ;; Manage tests + (:export #:define-test #:test-count #:test-total-count #:run-koans) + ;; Test blank + (:export #:____)) + +(in-package #:lisp-koans.test) + +;; The self-evaluating test blank allows many Lisp forms in the koans to compile +;; without errors. + +(defvar ____ '____) + +;;; Global unit test database + +(defparameter *test-db* (make-hash-table :test #'eq)) + +(defun package-table (package) + (multiple-value-bind (value foundp) (gethash (find-package package) *test-db*) + (if foundp + value + (setf (gethash package *test-db*) '())))) + +(defun (setf package-table) (new-value package) + (setf (gethash (find-package package) *test-db*) new-value)) + +(defmacro define-test (name &body body) + "Store the test in the test database." + `(progn + (pushnew (list ',name ',body) (package-table *package*) + :test (lambda (x y) (eq (car x) (car y)))) + ',name)) + +;;; Test statistics + +(defun test-count (&optional (package *package*)) + "Returns the number of tests for a package." + (let ((table (package-table package))) + (length table))) + +(defun test-total-count () + "Returns the total number of tests." + (loop for table being the hash-values of *test-db* + sum (length table))) + +;;; Test passed predicate. + +(defun test-passed-p (type expected actual test) + (ecase type + (:error (or (eql (car actual) (car expected)) (subtypep (car actual) (car expected)))) + (:equal (and (>= (length expected) (length actual)) (every test expected actual))) + (:macro (equal (car actual) (car expected))) + (:result (eql (not (car actual)) (not (car expected)))))) + +(defun form-contains-blanks-p (form) + (typecase form + (symbol (eq form '____)) + (cons (or (form-contains-blanks-p (car form)) + (form-contains-blanks-p (cdr form)))))) + +(defun notnot (x) (not (not x))) + +(defvar *koan-assert-list*) + +(defun internal-assert (type form code-thunk expected-thunk test) + (if (form-contains-blanks-p form) + (push :incomplete *koan-assert-list*) + (let* ((expected (multiple-value-list (funcall expected-thunk))) + (actual (multiple-value-list (funcall code-thunk))) + (passed (test-passed-p type expected actual test)) + (result (if passed :pass :fail))) + (push result *koan-assert-list*)))) + +(defmacro expand-assert (type form body expected &key (test '#'eql)) + `(internal-assert ,type ',form (lambda () ,body) (lambda () ,expected) ,test)) + +;;; Assert macros + +(defmacro assert-eq (form expected) + "Assert whether expected and form are EQ." + `(expand-assert :equal ,form ,form ,expected :test #'eq)) + +(defmacro assert-eql (form expected) + "Assert whether expected and form are EQL." + `(expand-assert :equal ,form ,form ,expected :test #'eql)) + +(defmacro assert-equal (form expected) + "Assert whether expected and form are EQUAL." + `(expand-assert :equal ,form ,form ,expected :test #'equal)) + +(defmacro assert-equalp (form expected) + "Assert whether expected and form are EQUALP." + `(expand-assert :equal ,form ,form ,expected :test #'equalp)) + +(defmacro true-or-false? (form expected) + "Assert whether expected and form are logically equivalent." + `(expand-assert :equal ,form (notnot ,form) (notnot ,expected) :test #'eql)) + +(defmacro assert-error (form condition) + "Assert whether form signals condition." + (let ((e (gensym "E"))) + `(expand-assert :error ,form (handler-case ,form (error (,e) (type-of ,e))) + ,condition))) + +(defmacro assert-expands (form expected) + "Assert whether form expands to expansion." + `(expand-assert :macro ',form (macroexpand-1 ',form) ,expected)) + +(defmacro assert-false (form) + "Assert whether the form is false." + `(expand-assert :result ,form ,form nil)) + +(defmacro assert-true (form) + "Assert whether the form is true." + `(expand-assert :result ,form (notnot ,form) t)) + +;;; Run the tests + +(defun run-koan (code) + (let ((*koan-assert-list* nil)) + (handler-case (funcall (coerce `(lambda () ,@code) 'function)) + (error () (push :error *koan-assert-list*))) + *koan-assert-list*)) + +(defun run-koans (package) + "Run all koans for a given package." + (loop with results = nil + for (test-name unit-test) in (reverse (package-table package)) + for koan-result = (run-koan unit-test) + do (push (list test-name koan-result) results) + while (every (lambda (x) (eq x :pass)) koan-result) + finally (return results))) diff --git a/lisp-koans/test.lisp b/lisp-koans/test.lisp new file mode 100644 index 0000000..9441a1d --- /dev/null +++ b/lisp-koans/test.lisp @@ -0,0 +1,29 @@ +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +(in-package :cl-user) + +;;; Though Clozure / CCL runs lisp-koans on the command line using +;;; "ccl -l contemplate.lisp", the following lines are needed to +;;; meditate on the koans within the CCL IDE. +;;; (The :hemlock is used to distiguish between ccl commandline and the IDE) +#+(and :ccl :hemlock) +(setf *default-pathname-defaults* (directory-namestring *load-pathname*)) + +(load "test-framework.lisp") +(load "lisp-koans.lisp") + +#+quicklisp (ql:quickload :bordeaux-threads) + +(lisp-koans.core:main "koans-solved")