diff --git a/.koans b/.koans index bf11e5fb..198230a3 100644 --- a/.koans +++ b/.koans @@ -17,14 +17,14 @@ #:iteration #:mapcar-and-reduce #:control-statements - #:condition-handlers #:loops - #:triangle-project #:scoring-project #:format #:type-checking #:clos #:std-method-comb + #:condition-handlers + #:triangle-project #:dice-project #:macros #:scope-and-extent diff --git a/koans/control-statements.lisp b/koans/control-statements.lisp index 8db29d6f..a5952854 100644 --- a/koans/control-statements.lisp +++ b/koans/control-statements.lisp @@ -1,70 +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. +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. -;; TODO return-from - -(define-test test-if-then-else +(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 value") - (setf result "false value")) - (assert-equal result ____) + (setf result :true) + (setf result :false)) + (assert-equal ____ result) (if nil - (setf result "true value") - (setf result "false value")) - (assert-equal result ____))) - - -(define-test test-when-and-unless - (let ((result-1 nil) - (result-2 nil) - (when-nums nil) - (unless-nums nil)) - (dolist (x '(1 2 3 4 5 6 7 8 9 10)) - (when (> x 5) - (setf result-1 x) - (push x when-nums)) - (unless (> x 5) - (setf result-2 x) - (push x unless-nums))) - (assert-equal result-1 ___) - (assert-equal result-2 ___) - (assert-equal when-nums ___) - (assert-equal unless-nums ___))) - + (setf result :true) + (setf result :false)) + (assert-equal ____ result))) -(define-test test-and-short-circuits - "and only evaluates forms until one evaluates to nil" - (assert-equal - ____ - (let ((x 0)) - (and - (setf x (+ 1 x)) - (setf x (+ 1 x)) - nil ;; <- ends execution of and. - (setf x (+ 1 x))) - x))) +(define-test when-unless + ;; WHEN and UNLESS are like one-branched IF statements. + (let ((when-result nil) + (when-numbers '()) + (unless-result nil) + (unless-numbers '())) + (dolist (x '(1 2 3 4 5 6 7 8 9 10)) + (when (> x 5) + (setf when-result x) + (push x when-numbers)) + (unless (> x 5) + (setf unless-result x) + (push x unless-numbers))) + (assert-equal ____ when-result) + (assert-equal ____ when-numbers) + (assert-equal ____ unless-result) + (assert-equal ____ unless-numbers))) +(define-test and-short-circuit + ;; AND only evaluates forms until one evaluates to NIL. + (assert-equal ____ + (let ((x 0)) + (and + (setf x (+ 1 x)) + (setf x (+ 1 x)) + nil + (setf x (+ 1 x))) + x))) -(define-test test-or-also-short-circuits - "or only evaluates until one argument evaluates to non-nil" - (assert-equal - ____ - (let ((x 0)) - (or - (setf x (+ 1 x)) - (setf x (+ 1 x)) - nil - (setf x (+ 1 x))) - x))) +(define-test or-short-circuit + ;; AND only evaluates forms until one evaluates to non-NIL. + (assert-equal ____ + (let ((x 0)) + (or + (setf x (+ 1 x)) + (setf x (+ 1 x)) + nil + (setf x (+ 1 x))) + x))) diff --git a/koans/format.lisp b/koans/format.lisp index 804a9611..39d0e6fa 100644 --- a/koans/format.lisp +++ b/koans/format.lisp @@ -1,56 +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. - - -;; FORMAT is lisp's counterpart to the c function printf. Refer to -;; http://www.gigamonkeys.com/book/a-few-format-recipes.html for more -;; on this topic. - - -;; FORMAT takes two fixed parameters. The first one specifies an -;; output stream that the result goes to, and if left as nil, FORMAT -;; will return the output as a string instead. The second parameter -;; specifies the format, where format specifier will be replaced by -;; formatting the rest of the parameters. - -(define-test test-format-with-plain-text - "If there is no format specifier, FORMAT just returns the string - itself." - (assert-equal ___ (format nil "this is plain text."))) - -(define-test test-format-with-general-specifier - "~a is a general specifier that translates to the print form of a - parameter." - (assert-equal ___ (format nil "~a" 42)) - (assert-equal ___ (format nil "~a" #\C)) - (assert-equal ___ (format nil "~a" "galaxy far far away")) - ;; ~a can also translate to list - ;; and parameters to FORMAT are passed by value - (assert-equal ___ - (format nil "~a evaluates to ~a" - '(/ 8 (- 3 (/ 8 3))) - (/ 8 (- 3 (/ 8 3)))))) - -(define-test some-fancy-specifiers - "format enclosed by ~{ and ~} applies to every element in a list." - (assert-equal ___ - (format nil "~{[~a]~}" '(1 2 3 4))) - ;; ~^ within the ~{ ~} stops processing the last element in the list. - (assert-equal "1|2|3|4|" (format nil ___ '(1 2 3 4))) - (assert-equal ___ (format nil "~{~a~^|~}" '(1 2 3 4))) - ;; ~r reads the integer - (assert-equal ___ (format nil "~r" 42)) - ;; put them all together - (assert-equal ___ - (format nil "~{~r~^,~}" '(1 2 3 4)))) +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; The function FORMAT is used to create formatted output. It is similar to +;;; the C function printf(). +;;; See http://www.gigamonkeys.com/book/a-few-format-recipes.html + +;;; T as the first argument to FORMAT prints the string to standard output. +;;; NIL as the first argument to FORMAT causes it to return the string. + +(define-test format-basic + ;; If there are no format directives in the string, FORMAT will return + ;; a string that is STRING= to its format control. + (assert-equal ____ (format nil "Lorem ipsum dolor sit amet"))) + +(define-test format-aesthetic + ;; The ~A format directive creates aesthetic output. + (assert-equal ____ (format nil "This is the number ~A" 42)) + (assert-equal ____ (format nil "This is the keyword ~A" :foo)) + (assert-equal ____ (format nil "~A evaluates to ~A" + '(/ 24 (- 3 (/ 8 3))) + (/ 24 (- 3 (/ 8 3))))) + (assert-equal ____ (format nil "This is the character ~A" #\C)) + (assert-equal ____ (format nil "In a ~A" "galaxy far far away"))) + +(define-test format-standard + ;; The ~S format directive prints objects with escape characters. + ;; Not all Lisp objects require to be escaped. + (assert-equal ____ (format nil "This is the number ~S" 42)) + (assert-equal ____ (format nil "~S evaluates to ~S" + '(/ 24 (- 3 (/ 8 3))) + (/ 24 (- 3 (/ 8 3))))) + ;; Keywords are printed with their leading colon. + (assert-equal ____ (format nil "This is the keyword ~S" :foo)) + ;; Characters are printed in their #\X form. The backslash will need to be + ;; escaped inside the printed string, just like in "#\\X". + (assert-equal ____ (format nil "This is the character ~S" #\C)) + ;; Strings include quote characters, which must be escaped: + ;; such a string might look in code like "foo \"bar\"". + (assert-equal ____ (format nil "In a ~S" "galaxy far far away"))) + +(define-test format-radix + ;; The ~B, ~O, ~D, and ~X radices print numbers in binary, octal, decimal, and + ;; hexadecimal notation. + (assert-equal ____ (format nil "This is the number ~B" 42)) + (assert-equal ____ (format nil "This is the number ~O" 42)) + (assert-equal ____ (format nil "This is the number ~D" 42)) + (assert-equal ____ (format nil "This is the number ~X" 42)) + ;; We can specify a custom radix by using the ~R directive. + (assert-equal ____ (format nil "This is the number ~3R" 42)) + ;; It is possible to print whole forms this way. + (let ((form '(/ 24 (- 3 (/ 8 3)))) + (result (/ 24 (- 3 (/ 8 3))))) + (assert-equal ____ (format nil "~B evaluates to ~B" form result)) + (assert-equal ____ (format nil "~O evaluates to ~O" form result)) + (assert-equal ____ (format nil "~D evaluates to ~D" form result)) + (assert-equal ____ (format nil "~X evaluates to ~X" form result)) + (assert-equal ____ (format nil "~3R evaluates to ~3R" form result)))) + +(define-test format-iteration + ;; The ~{ and ~} directives iterate over a list. + (assert-equal ____ (format nil "~{[~A]~}" '(1 2 3 4 5 6))) + (assert-equal ____ (format nil "~{[~A ~A]~}" '(1 2 3 4 5 6))) + ;; The directive ~^ aborts iteration when no more elements remain. + (assert-equal ____ (format nil "~{[~A]~^, ~}" '(1 2 3 4 5 6)))) + +(define-test format-case + ;; The ~( and ~) directives adjust the string case. + (assert-equal ____ (format nil "~(~A~)" "The QuIcK BROWN fox")) + ;; Some FORMAT directives can be further adjusted with the : and @ modifiers. + (assert-equal ____ (format nil "~:(~A~)" "The QuIcK BROWN fox")) + (assert-equal ____ (format nil "~@(~A~)" "The QuIcK BROWN fox")) + (assert-equal ____ (format nil "~:@(~A~)" "The QuIcK BROWN fox"))) diff --git a/koans/iteration.lisp b/koans/iteration.lisp index 61364c6f..20385cbd 100644 --- a/koans/iteration.lisp +++ b/koans/iteration.lisp @@ -1,116 +1,58 @@ -;; 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 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 loop-basic-form + ;; The macro LOOP in its simple form loops forever. It is possible to stop the + ;; looping by calling the RETURN special form. + (let ((counter 0)) + (loop (incf counter) + (when (>= counter 100) + (return counter))) + (assert-equal ___ loop-counter)) + ;; The RETURN special form can return a value out of a LOOP. + (let ((loop-counter 0)) + (assert-equal ___ (loop (incf counter) + (when (>= counter 100) + (return counter))))) + ;; The extended form of LOOP will be contemplated in a future koan. + ) - -;; There are many options for iteration in lisp. -;; This set of koans will introduce a few of the most common ones - - -;; Dolist evaluates a form for every element of a list. - -(defvar some-primes '(10301 11311 19991 999565999)) - -(define-test test-dolist - "'dolist' iterates over values in a list, binding each value to a lexical - variable in turn" - (let ((how-many-in-list 0) - (biggest-in-list (first some-primes))) - "this dolist loops over some-primes, defined above" - (dolist (one-prime some-primes) - (if (> one-prime biggest-in-list) - (setf biggest-in-list one-prime)) - (incf how-many-in-list)) - (assert-equal ___ how-many-in-list) - (assert-equal ___ biggest-in-list)) - (let ((sum 0)) - "write your own dolist here to calculate the sum of some-primes - you may be interested in investigating the 'incf' function" - ;(dolist ... ) - (assert-equal 999607602 sum))) - - -(define-test test-dolist-with-return - "Dolist can accept a return variable, which will be the return value - upon completion of the iteration." - (let ((my-list '(1 2 3 4)) - (my-return)) - (dolist (x my-list my-return) - (push (* x x) my-return)) - (assert-equal ____ my-return))) - - -(define-test test-dotimes - "'dotimes' iterates over the integers from 0 to (limit - 1), - binding them in order to your selected symbol." - (let ((out-list nil)) - (dotimes (y 3) (push y out-list)) - (assert-equal out-list ___))) - - -(defvar *x* "global") -(define-test test-dotimes-binding - "dotimes establishes a local lexical binding which may shadow - a global value." - (dotimes (*x* 4) - (true-or-false? ___ (equal "global" *x*))) - (true-or-false? ___ (equal "global" *x*))) - - -(define-test test-loop-until-return - "Loop loops forever, unless some return condition is executed. - Note that the loop macro includes many additional options, - which will be covered in a future koan." - (let ((loop-counter 0)) - (loop - (incf loop-counter) - (if (>= loop-counter 100) (return loop-counter))) - (assert-equal ___ loop-counter))) - - -(define-test test-mapcar - "mapcar takes a list and a function. It returns a new list - with the function applied to each element of the input" - (let ((mc-result (mapcar #'evenp '(1 2 3 4 5)))) - (assert-equal mc-result ____))) - - -;; ---- - - -(defun vowelp (c) - "returns true if c is a vowel" - (find c "AEIOUaeiou")) - -(defun vowels-to-xs (my-string) - "converts all vowels in a string to the character 'x'" - (coerce - (loop for c across my-string - with new-c - do (setf new-c (if (vowelp c) #\x c)) - collect new-c) - 'string)) - -(define-test test-mapcar-with-defun - "mapcar is a convenient way to apply a function to a collection" - (assert-equal (vowels-to-xs "Astronomy") "xstrxnxmy") - (let* ((subjects '("Astronomy" "Biology" "Chemistry" "Linguistics")) - (mc-result (mapcar #'vowels-to-xs subjects))) - (assert-equal mc-result ____))) - - -;; ---- - -(define-test test-mapcar-with-lambda - (let ((mc-result (mapcar (lambda (x) (mod x 10)) '(21 152 403 14)))) - (assert-equal mc-result ____))) diff --git a/koans/loops.lisp b/koans/loops.lisp index 6fa3fc54..85429bdd 100644 --- a/koans/loops.lisp +++ b/koans/loops.lisp @@ -1,165 +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. - -;; see http://www.gigamonkeys.com/book/loop-for-black-belts.html -;; "Loop for blackbelts" for more on the loop macro. - -(define-test test-basic-loop - (let* ((letters '(:a :b :c :d)) - (loop-result - (loop for letter in letters - collect letter))) - (assert-equal loop-result ____))) - - -(define-test test-compound-loop - (let* ((letters '(:a :b :c :d)) - (loop-result - (loop for letter in letters - for i from 1 to 1000 - collect (list i letter)))) - (assert-equal loop-result ____))) - - -(define-test test-counting-loop-skip-by-syntax - "with multiple 'for' clauses, loop ends when the first is exhausted" - (let* ((letters '(:a :b :c :d)) - (loop-result - (loop for letter in letters - for i from 0 to 1000 by 5 - collect (list i letter)))) - (assert-equal loop-result ____ ))) - - -(define-test test-counting-backwards - (let ((loop-result - (loop for i from 10 downto -10 by 5 - collect i ))) - (assert-equal loop-result ____ ))) - - -(define-test test-loop-in-vs-loop-on - (let* ((letters '(:a :b :c)) - (loop-result-in - (loop for letter in letters collect letter)) - (loop-result-on - (loop for letter on letters collect letter))) - (assert-equal loop-result-in ____) - (assert-equal loop-result-on ____ ))) - - -(define-test test-loop-in-skip-by - (let* ((letters '(:a :b :c :d :e :f)) - (loop-result-in - (loop for letter in letters collect letter)) - (loop-result-in-cdr - (loop for letter in letters by #'cdr collect letter)) - (loop-result-in-cddr - (loop for letter in letters by #'cddr collect letter)) - (loop-result-in-cdddr - (loop for letter in letters by #'cdddr collect letter))) - (assert-equal loop-result-in ____) - (assert-equal loop-result-in-cdr ____) - (assert-equal loop-result-in-cddr ____) - (assert-equal loop-result-in-cdddr ____))) - - -(define-test test-loop-across-vector - (let* ((my-vector (make-array '(5) :initial-contents '(0 1 2 3 4))) - (loop-result - (loop for val across my-vector collect val))) - (assert-equal ____ loop-result))) - - -(define-test test-loop-across-2d-array - (let* ((my-array (make-array '(3 3) :initial-contents '((0 1 2) (3 4 5) (6 7 8)))) - (loop-result - (loop for i from 0 below (array-total-size my-array) collect (row-major-aref my-array i)))) - (assert-equal loop-result ____ ))) - - -(define-test test-loop-across-2d-array-respecting-shape - (let* ((my-array (make-array '(3 2) :initial-contents '((0 1) (2 3) (4 5)))) - (loop-result - (loop for i from 0 below (array-dimension my-array 0) collect - (loop for j from 0 below (array-dimension my-array 1) collect - (expt (aref my-array i j) 2))))) - (assert-equal loop-result ____ ))) - - -(defvar books-to-heros) -(setf books-to-heros (make-hash-table :test 'equal)) -(setf (gethash "The Hobbit" books-to-heros) "Bilbo") -(setf (gethash "Where The Wild Things Are" books-to-heros) "Max") -(setf (gethash "The Wizard Of Oz" books-to-heros) "Dorothy") -(setf (gethash "The Great Gatsby" books-to-heros) "James Gatz") - - -(define-test test-loop-over-hash-tables - (let* ((pairs-in-table - (loop for k being the hash-keys in books-to-heros - using (hash-value v) - collect (list k v)))) +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; The extended for of LOOP allows for advanced iteration. +;;; See http://www.gigamonkeys.com/book/loop-for-black-belts.html + +(define-test loop-collect + ;; LOOP can collect the results in various ways. + (let* ((result-1 (loop for letter in '(#\a \b #\c #\d) collect letter)) + (result-2 (loop for number in '(1 2 3 4 5) sum number)) + (result-3 (loop for list in '((foo) (bar) (baz)) append list))) + (assert-equal ____ result-1) + (assert-equal ____ result-2) + (assert-equal ____ result-3))) + +(define-test loop-multiple-variables + ;; With multiple FOR clauses, the loop ends when any of the provided lists are + ;; exhausted. + (let* ((letters '(:a :b :c :d)) + (result (loop for letter in letters + for i from 1 to 1000 + collect (list i letter)))) + (assert-equal ____ result))) + +(define-test loop-in-versus-loop-on + ;; Instead of iterating over each element of a list, we can iterate over each + ;; cons cell of a list. + (let* ((letters '(:a :b :c)) + (result-in (loop for thing in letters collect thing)) + (result-on (loop for thing on letters collect thing))) + (assert-equal ____ result-in) + (assert-equal ____ result-on))) + +(define-test loop-for-by + ;; Numeric iteration can go faster or slower if we use the BY keyword. + (let* ((result (loop for i from 0 to 30 by 5 collect i))) + (assert-equal ____ result))) + +(define-test loop-counting-backwards + ;; We can count downwards instead of upwards by using DOWNTO instead of TO. + (let ((result (loop for i from 5 downto -5 collect i))) + (assert-equal ____ result))) + +(define-test loop-list-by + ;; List iteration can go faster or slower if we use the BY keyword. + (let* ((letters '(:a :b :c :d :e :f)) + (result (loop for letter in letters collect letter)) + (result-cdr (loop for letter in letters by #'cdr collect letter)) + (result-cddr (loop for letter in letters by #'cddr collect letter)) + (result-cdddr (loop for letter in letters by #'cdddr collect letter))) + (assert-equal ____ result-in) + (assert-equal ____ result-in-cdr) + (assert-equal ____ result-in-cddr) + (assert-equal ____ result-in-cdddr))) + +(define-test loop-across + ;; LOOP can iterate over a vector with the ACROSS keyword. + (let* ((vector (make-array '(5) :initial-contents '(0 1 2 3 4))) + (result (loop for number across vector collect number))) + (assert-equal ____ result))) + +(define-test loop-over-2d-array + (let ((array (make-array '(3 2) :initial-contents '((0 1) (2 3) (4 5))))) + ;; LOOP can be combined with ROW-MAJOR-AREF to iterate over the contents of + ;; a multidimensional array. + (let* ((result (loop for i from 0 below (array-total-size array) + collect (row-major-aref my-array i)))) + (assert-equal ____ result)) + ;; It is always possible to resort to nested loops. + (let* ((result (loop with max-i = (array-dimension array 0) + for i from 0 below max-i + collect (loop with max-j = (array-dimension array 1) + for j from 0 below max-j + collect (expt (aref my-array i j) 2))))) + (assert-equal ____ result)))) + +(define-test loop-hash-table + (let ((book-heroes (make-hash-table :test 'equal))) + (setf (gethash "The Hobbit" book-heroes) "Bilbo" + (gethash "Where The Wild Things Are" book-heroes) "Max" + (gethash "The Wizard Of Oz" book-heroes) "Dorothy" + (gethash "The Great Gatsby" book-heroes) "James Gatz") + ;; LOOP can iterate over hash tables. + (let (pairs-in-table (loop for key being the hash-key of book-heroes + using (hash-value value) + collect (list key value))) (assert-equal ____ (length pairs-in-table)) - (true-or-false? ____ (find '("The Hobbit" "Bilbo") pairs-in-table :test #'equal)))) - - -(define-test test-value-accumulation-forms - (let ((loop-1 - (loop for x in '(1 2 4 8 16) - collect x into collected - count x into counted - sum x into summed - maximize x into maximized - minimize x into minimized - finally (return (list collected counted summed maximized minimized))))) - (destructuring-bind (col count sum max min) loop-1 - (assert-equal col ____) - (assert-equal count ____) - (assert-equal sum ____) - (assert-equal max ____) - (assert-equal min ____)))) - - -(define-test test-destructuring-bind - (let* ((count 0) - (result (loop for (a b) in '((1 9) (2 8) (3 7) (4 6)) - do (setf count (+ 1 count)) - collect (+ a b)))) - (assert-equal ____ count) - (assert-equal ____ result))) - - -(define-test test-conditional-execution - (let ((loop-return - (loop for x in '(1 1 2 3 5 8 13) - when (evenp x) sum x))) - (assert-equal loop-return ____))) - - -(defun greater-than-10-p (x) - (> x 10)) - -(define-test test-conditional-with-defun - (let ((loop-return - (loop for x in '(1 1 2 3 5 8 13) - when (greater-than-10-p x) sum x))) - (assert-equal loop-return ____))) - - -(define-test test-conditional-with-lambda - (let ((loop-return - (loop for x in '(1 1 2 3 5 8 13) - when ((lambda (z) (equal 1 (mod z 3))) x) sum x))) - (assert-equal loop-return ____))) \ No newline at end of file + (true-or-false? ____ (find '("The Hobbit" "Bilbo") pairs-in-table + :test #'equal))))) + +(define-test loop-statistics + ;; LOOP can perform basics statistics on the collected elements. + (let ((result (loop for x in '(1 2 4 8 16 32) + collect x into collected + count x into counted + sum x into summed + maximize x into maximized + minimize x into minimized + finally (return (list collected counted summed + maximized minimized))))) + (destructuring-bind (collected counted summed maximized minimized) result + (assert-equal ____ collected) + (assert-equal ____ counted) + (assert-equal ____ summed) + (assert-equal ____ maximized) + (assert-equal ____ minimized)))) + +(define-test loop-destructuring + ;; LOOP can bind multiple variables on each iteration step. + (let* ((count 0) + (result (loop for (a b) in '((1 9) (2 8) (3 7) (4 6)) + do (incf count) + collect (+ a b)))) + (assert-equal ____ count) + (assert-equal ____ result))) + +(define-test conditional-execution + (let ((numbers '(1 1 2 3 5 8 13 21))) + ;; LOOP can execute some actions conditionally. + (let ((result (loop for x in numbers + when (evenp x) sum x))) + (assert-equal ____ result)) + (let ((result (loop for x in numbers + unless (evenp x) sum x))) + (assert-equal ____ result)) + (flet ((greater-than-10-p (x) (> x 10))) + (let ((result (loop for x in numbers + when (greater-than-10-p 10) sum x))) + (assert-equal ____ result))))) diff --git a/koans/mapcar-and-reduce.lisp b/koans/mapcar-and-reduce.lisp index 260f9069..4df282a6 100644 --- a/koans/mapcar-and-reduce.lisp +++ b/koans/mapcar-and-reduce.lisp @@ -1,82 +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. +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. -(define-test test-mapcar-basics - "We can apply a function to each member - of a list using mapcar." - (defun times-two (x) (* x 2)) - (assert-equal ____ (mapcar #'times-two '(1 2 3))) - (assert-equal ____ (mapcar #'first '((3 2 1) - ("little" "small" "tiny") - ("pigs" "hogs" "swine"))))) +;;; 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 test-mapcar-multiple-lists - "The mapcar function can be applied to - more than one list. It applies a function - to successive elements of the lists." - (assert-equal ____ (mapcar #'* '(1 2 3) '(4 5 6))) - (assert-equal ____ (mapcar #'list '("lisp" "are") '("koans" "fun")))) +(define-test mapcar-lambda + ;; MAPCAR is often used with anonymous functions. + (let ((numbers '(8 21 152 37 403 14 7 -34))) + (assert-equal ____ (mapcar (lambda (x) (mod x 10)) numbers))) + (let ((strings '("Mary had a little lamb" + "Old McDonald had a farm" + "Happy birthday to you"))) + (assert-equal ____ (mapcar (lambda (x) (subseq x 4 12)) strings)))) +(define-test map + ;; MAP is a variant of MAPCAR that works on any sequences. + ;; It allows to specify the type of the resulting sequence. + (let ((string "lorem ipsum")) + (assert-equal ____ (map 'string #'char-upcase string)) + (assert-equal ____ (map 'list #'char-upcase string)) + ;; Not all vectors containing characters are strings. + (assert-equal ____ (map '(vector t) #'char-upcase string)))) -(define-test test-transpose-using-mapcar - "Replace the usage of WRONG-FUNCTION in 'transpose' with the - correct lisp function (don't forget the #')." - (defun WRONG-FUNCTION-1 (&rest rest) '()) - (defun transpose (L) (apply #'mapcar (cons #'WRONG-FUNCTION-1 L))) - (assert-equal '((1 4 7) - (2 5 8) - (3 6 9)) - (transpose '((1 2 3) - (4 5 6) - (7 8 9)))) - (assert-equal '(("these" "pretzels" "are") - ("making" "me" "thirsty")) - (transpose '(("these" "making") - ("pretzels" "me") - ("are" "thirsty"))))) +(define-test 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 test-reduce-basics - "The reduce function combines the elements - of a list, from left to right, by applying - a binary function to the list elements." - (assert-equal ___ (reduce #'+ '(1 2 3 4))) - (assert-equal ___ (reduce #'expt '(2 3 2)))) +(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 test-reduce-right-to-left - "The keyword :from-end allows us to apply - reduce from right to left." - (assert-equal ___ (reduce #'+ '(1 2 3 4) :from-end t)) - (assert-equal ___ (reduce #'expt '(2 3 2) :from-end t))) - - -(define-test test-reduce-with-initial-value - "We can supply an initial value to reduce." - (assert-equal ___ (reduce #'expt '(10 21 34 43) :initial-value 1)) - (assert-equal ___ (reduce #'expt '(10 21 34 43) :initial-value 0))) - - -(defun WRONG-FUNCTION-2 (a b) (a)) -(defun WRONG-FUNCTION-3 (a b) (a)) - -(define-test test-mapcar-and-reduce - "mapcar and reduce are a powerful combination. - insert the correct function names, instead of WRONG-FUNCTION-X - to define an inner product." - (defun inner (x y) - (reduce #'WRONG-FUNCTION-2 (mapcar #'WRONG-FUNCTION-3 x y))) - (assert-equal 32 (inner '(1 2 3) '(4 5 6))) - (assert-equal 310 (inner '(10 20 30) '(4 3 7)))) +(define-test inner-product + ;; MAPCAR and REDUCE are powerful when used together. + ;; Fill in the blanks to produce a local function that computes an inner + ;; product of two vectors. + (flet ((inner-product (x y) (reduce ____ (mapcar ____ x y)))) + (assert-equal 32 (inner-product '(1 2 3) '(4 5 6))) + (assert-equal 310 (inner-product '(10 20 30) '(4 3 7))))) diff --git a/koans/scoring-project.lisp b/koans/scoring-project.lisp index e4a0f785..33aea48a 100644 --- a/koans/scoring-project.lisp +++ b/koans/scoring-project.lisp @@ -1,85 +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 !! ;; -;;;;;;;;;;;;;; - - -;; Modified from Ruby Koans: about_scoring_project.rb - -; *Greed* is a dice game where you roll up to five dice to accumulate -; points. The following "score" function will be used to calculate the -; score of a single roll of the dice. -; -; A greed roll is scored as follows: -; -; * A set of three ones is 1000 points -; -; * A set of three numbers (other than ones) is worth 100 times the -; number. (e.g. three fives is 500 points). -; -; * A one (that is not part of a set of three) is worth 100 points. -; -; * A five (that is not part of a set of three) is worth 50 points. -; -; * Everything else is worth 0 points. -; -; -; Examples: -; -; (score '(1 1 1 5 1)) => 1150 points -; (score '(2 3 4 6 2)) => 0 points -; (score '(3 4 5 3 3)) => 350 points -; (score '(1 5 1 2 4)) => 250 points -; -; More scoring examples are given in the tests below: -; -; Your goal is to write the score method. - -(defun score (dice) - ; You need to write this method -) - -(define-test test-score-of-an-empty-list-is-zero - (assert-equal 0 (score nil))) - -(define-test test-score-of-a-single-roll-of-5-is-50 - (assert-equal 50 (score '(5)))) - - -(define-test test-score-of-a-single-roll-of-1-is-100 - (assert-equal 100 (score '(1)))) - -(define-test test-score-of-multiple-1s-and-5s-is-the-sum-of-individual-scores - (assert-equal 300 (score '(1 5 5 1)))) - -(define-test test-score-of-single-2s-3s-4s-and-6s-are-zero - (assert-equal 0 (score '(2 3 4 6)))) - - -(define-test test-score-of-a-triple-1-is-1000 - (assert-equal 1000 (score '(1 1 1)))) - -(define-test test-score-of-other-triples-is-100x - (assert-equal 200 (score '(2 2 2))) - (assert-equal 300 (score '(3 3 3))) - (assert-equal 400 (score '(4 4 4))) - (assert-equal 500 (score '(5 5 5))) - (assert-equal 600 (score '(6 6 6)))) - -(define-test test-score-of-mixed-is-sum - (assert-equal 250 (score '(2 5 2 2 3))) - (assert-equal 550 (score '(5 5 5 5)))) +;;; Copyright 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. + +;;; Greed is a dice game played among 2 or more players, using 5 +;;; six-sided dice. +;;; +;;; Each player takes a turn consisting of one or more rolls of the dice. +;;; On the first roll of the game, a player rolls all five dice which are +;;; scored according to the following: +;;; +;;; Three 1's => 1000 points +;;; Three 6's => 600 points +;;; Three 5's => 500 points +;;; Three 4's => 400 points +;;; Three 3's => 300 points +;;; Three 2's => 200 points +;;; One 1 => 100 points +;;; One 5 => 50 points +;;; +;;; A single die can only be counted once in each roll. For example, +;;; a "5" can only count as part of a triplet (contributing to the 500 +;;; points) or as a single 50 points, but not both in the same roll. +;;; +;;; Example Scoring +;;; +;;; Throw Score +;;; --------- ------------------ +;;; 5 1 3 4 1 50 + 2 * 100 = 250 +;;; 1 1 1 3 1 1000 + 100 = 1100 +;;; 2 4 4 5 4 400 + 50 = 450 +;;; +;;; The dice not contributing to the score are called the non-scoring +;;; dice. "3" and "4" are non-scoring dice in the first example. "3" is +;;; a non-scoring die in the second, and "2" is a non-score die in the +;;; final example. +;;; +;;; More scoring examples are given in the tests below. +;;; +;;; Your goal is to write the scoring function for Greed. + +(defun score (&rest dice) + ____) + +(define-test score-of-an-empty-list-is-zero + (assert-equal 0 (score))) + +(define-test score-of-a-single-roll-of-5-is-50 + (assert-equal 50 (score 5))) + +(define-test score-of-a-single-roll-of-1-is-100 + (assert-equal 100 (score 1))) + +(define-test score-of-multiple-1s-and-5s-is-the-sum-of-individual-scores + (assert-equal 300 (score 1 5 5 1))) + +(define-test score-of-single-2s-3s-4s-and-6s-are-zero + (assert-equal 0 (score 2 3 4 6))) + +(define-test score-of-a-triple-1-is-1000 + (assert-equal 1000 (score 1 1 1))) + +(define-test score-of-other-triples-is-100x + (assert-equal 200 (score 2 2 2)) + (assert-equal 300 (score 3 3 3)) + (assert-equal 400 (score 4 4 4)) + (assert-equal 500 (score 5 5 5)) + (assert-equal 600 (score 6 6 6))) + +(define-test score-of-mixed-is-sum + (assert-equal 250 (score 2 5 2 2 3)) + (assert-equal 550 (score 5 5 5 5))) diff --git a/koans/type-checking.lisp b/koans/type-checking.lisp index c8be8003..aec9010f 100644 --- a/koans/type-checking.lisp +++ b/koans/type-checking.lisp @@ -1,86 +1,86 @@ -;; 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 2013 Google Inc. +;;; +;;; Licensed under the Apache License, Version 2.0 (the "License"); +;;; you may not use this file except in compliance with the License. +;;; You may obtain a copy of the License at +;;; +;;; http://www.apache.org/licenses/LICENSE-2.0 +;;; +;;; Unless required by applicable law or agreed to in writing, software +;;; distributed under the License is distributed on an "AS IS" BASIS, +;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;;; See the License for the specific language governing permissions and +;;; limitations under the License. ;; Common lisp types have hierarchy. Any object may belong a family of types. ;; The top level type, which includes everything else, is 't' (define-test test-check-some-common-types - (true-or-false? ___ (typep "hello" 'string)) - (true-or-false? ___ (typep "hello" 'array)) - (true-or-false? ___ (typep "hello" 'list)) - (true-or-false? ___ (typep "hello" '(simple-array character (5)))) + (true-or-false? ___ (typep "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))) + (true-or-false? ___ (typep '(1 2 3) 'list)) + (true-or-false? ___ (typep 99 'integer)) + (true-or-false? ___ (typep nil 'NULL)) + (true-or-false? ___ (typep 22/7 'ratio)) + (true-or-false? ___ (typep 4.0 'float)) + (true-or-false? ___ (typep #\a 'character)) + (true-or-false? ___ (typep #'length 'function))) (define-test test-get-type-with-type-of - (assert-equal ____ (type-of ())) - (assert-equal ____ (type-of 4/6))) + (assert-equal ____ (type-of ())) + (assert-equal ____ (type-of 4/6))) (define-test test-type-sets-may-overlap - (true-or-false? ___ (typep () 'list)) - (true-or-false? ___ (typep () 'atom)) - (true-or-false? ___ (typep () 'NULL)) - (true-or-false? ___ (typep () t))) + (true-or-false? ___ (typep () 'list)) + (true-or-false? ___ (typep () 'atom)) + (true-or-false? ___ (typep () 'NULL)) + (true-or-false? ___ (typep () t))) (define-test test-integers-can-get-really-big - (true-or-false? ____ (typep 12345678901234567890123456789012 'integer)) - ;; Integers are either fixnum or bignum. - ;; The boundary between fixnum and bignum is given by the constant: - ;; most-positive-fixnum - (assert-true (typep 1234567890123456789 'fixnum)) - (assert-true (typep 12345678901234567890 'bignum)) - (true-or-false? ___ (typep most-positive-fixnum 'fixnum)) - (true-or-false? ___ (typep (+ 1 most-positive-fixnum) 'fixnum))) + (true-or-false? ____ (typep 12345678901234567890123456789012 'integer)) + ;; Integers are either fixnum or bignum. + ;; The boundary between fixnum and bignum is given by the constant: + ;; most-positive-fixnum + (assert-true (typep 1234567890123456789 'fixnum)) + (assert-true (typep 12345678901234567890 'bignum)) + (true-or-false? ___ (typep most-positive-fixnum 'fixnum)) + (true-or-false? ___ (typep (+ 1 most-positive-fixnum) 'fixnum))) (define-test test-lisp-type-system-is-hierarchy - (assert-true (typep 1 'bit)) - (assert-true (typep 1 'integer)) - (assert-true (typep 2 'integer)) - (true-or-false? ____ (subtypep 'bit 'integer)) - (true-or-false? ____ (subtypep (type-of 1) (type-of 2))) - (true-or-false? ____ (subtypep (type-of 2) (type-of 1)))) + (assert-true (typep 1 'bit)) + (assert-true (typep 1 'integer)) + (assert-true (typep 2 'integer)) + (true-or-false? ____ (subtypep 'bit 'integer)) + (true-or-false? ____ (subtypep (type-of 1) (type-of 2))) + (true-or-false? ____ (subtypep (type-of 2) (type-of 1)))) (define-test test-some-types-are-lists - (assert-true(typep (make-array 0 :element-type 'integer) '(SIMPLE-VECTOR 0))) - (true-or-false? ____ (typep (make-array '(3 3) :element-type 'integer) '(SIMPLE-ARRAY T (3 3))))) + (assert-true(typep (make-array 0 :element-type 'integer) '(SIMPLE-VECTOR 0))) + (true-or-false? ____ (typep (make-array '(3 3) :element-type 'integer) '(SIMPLE-ARRAY T (3 3))))) (define-test test-type-specifier-lists-also-have-hierarchy - (true-or-false? ____ (subtypep '(SIMPLE-ARRAY T (3 3)) '(SIMPLE-ARRAY T *))) - (true-or-false? ____ (subtypep '(vector double-float 100) '(vector * 100))) - (true-or-false? ____ (subtypep '(vector double-float 100) '(vector double-float *))) - (true-or-false? ____ (subtypep '(vector double-float 100) '(vector * *))) - (true-or-false? ____ (subtypep '(vector double-float 100) '(array number *))) - (true-or-false? ____ (subtypep '(vector double-float 100) t))) + (true-or-false? ____ (subtypep '(SIMPLE-ARRAY T (3 3)) '(SIMPLE-ARRAY T *))) + (true-or-false? ____ (subtypep '(vector double-float 100) '(vector * 100))) + (true-or-false? ____ (subtypep '(vector double-float 100) '(vector double-float *))) + (true-or-false? ____ (subtypep '(vector double-float 100) '(vector * *))) + (true-or-false? ____ (subtypep '(vector double-float 100) '(array number *))) + (true-or-false? ____ (subtypep '(vector double-float 100) t))) (define-test test-type-coersion - (assert-true (typep 0 'integer)) - (true-or-false? ___ (typep 0 'short-float)) - (true-or-false? ___ (subtypep 'integer 'short-float)) - (true-or-false? ___ (subtypep 'short-float 'integer)) - (true-or-false? ___ (typep (coerce 0 'short-float) 'short-float))) + (assert-true (typep 0 'integer)) + (true-or-false? ___ (typep 0 'short-float)) + (true-or-false? ___ (subtypep 'integer 'short-float)) + (true-or-false? ___ (subtypep 'short-float 'integer)) + (true-or-false? ___ (typep (coerce 0 'short-float) 'short-float))) (define-test test-atoms-are-anything-thats-not-a-cons @@ -92,7 +92,7 @@ (define-test test-functionp - "the functionp predicate is true iff the argument is a function" + "the functionp predicate is true iff the argument is a function" (assert-true (functionp (lambda (a b c) (+ a b c)))) (true-or-false? ___ (functionp #'make-array)) (true-or-false? ___ (functionp '(1 2 3))) @@ -100,7 +100,7 @@ (define-test test-there-are-some-other-type-predicates - ; see http://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node73.html for more. + ; see http://www.cs.cmu.edu/Groups/AI/html/cltl/clm/node73.html for more. (true-or-false? ___ (numberp 999)) (true-or-false? ___ (listp '(9 9 9))) (true-or-false? ___ (integerp 999)) @@ -112,9 +112,9 @@ (define-test test-guess-that-type! - (let ((x ____)) - (assert-true (subtypep x '(SIMPLE-ARRAY T (* 3 *)))) - (assert-true (subtypep x '(SIMPLE-ARRAY T (5 * *)))) - (assert-true (subtypep x '(SIMPLE-ARRAY ARRAY *))) - (assert-true (typep (make-array '(5 3 9) :element-type 'STRING ) x)) - (assert-true (typep (make-array '(5 3 33) :element-type 'VECTOR ) x)))) + (let ((x ____)) + (assert-true (subtypep x '(SIMPLE-ARRAY T (* 3 *)))) + (assert-true (subtypep x '(SIMPLE-ARRAY T (5 * *)))) + (assert-true (subtypep x '(SIMPLE-ARRAY ARRAY *))) + (assert-true (typep (make-array '(5 3 9) :element-type 'STRING ) x)) + (assert-true (typep (make-array '(5 3 33) :element-type 'VECTOR ) x))))