koans, stuff
dice - more practice with signal and clog backquote - first practice with @,a splicing macros - some news of common errors: - capturing outer symbols, so caller expects them to be used, but invisible internal values take their place - evaluating "pass by name" forms too many times - evaluating them in surprising order
This commit is contained in:
efim
parent
cdeeb2fead
commit
063c5c52d1
|
|
@ -19,23 +19,26 @@
|
|||
(let ((x '(123))
|
||||
(z '(7 8 9)))
|
||||
;; ' quotes an expression normally.
|
||||
(assert-equal ____ '(x 45 6 z))
|
||||
(assert-equal (list '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))
|
||||
(assert-equal '(x 45 6 z) `(x 45 6 z))
|
||||
;; , unquotes a part of the expression.
|
||||
(assert-equal ____ `(,x 45 6 z))
|
||||
(assert-equal ____ `(,x 45 6 ,z))
|
||||
(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 ____ `(,x 45 6 ,@z))
|
||||
(assert-equal ____ `(,@x 45 6 ,@z))))
|
||||
(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 ____
|
||||
(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
|
||||
|
|
@ -43,7 +46,9 @@
|
|||
(let ((error-type 'type-error)
|
||||
(error-arguments '(:datum x :expected-type 'string)))
|
||||
;; Fill in the blank without without using backquote/unquote notation.
|
||||
(assert-equal ____
|
||||
(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)))))
|
||||
|
|
@ -51,15 +56,15 @@
|
|||
(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))))
|
||||
(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 ____) `(the axis are ,axis))
|
||||
(assert-equal '(the axis are ____) `(the axis are ,@axis)))
|
||||
(assert-equal '(the axis are (x y z)) `(the axis are ,axis))
|
||||
(assert-equal '(the axis are x y z) `(the axis are ,@axis)))
|
||||
(let ((coordinates '((43.15 77.6) (42.36 71.06))))
|
||||
(assert-equal ____ `(the coordinates are ,coordinates))
|
||||
(assert-equal ____ `(the coordinates are ,@coordinates))))
|
||||
(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))))
|
||||
|
|
|
|||
|
|
@ -18,20 +18,29 @@
|
|||
|
||||
(defclass dice-set ()
|
||||
;; Fill in the blank with a proper slot definition.
|
||||
(____))
|
||||
((dice-values :initarg :dice-values)))
|
||||
|
||||
(setq *my-dice* (make-instance 'dice-set :dice-values '(1 2 3 5)))
|
||||
(slot-value *my-dice* 'dice-values)
|
||||
|
||||
;;; This method might be unnecessary, depending on how you define the slots of
|
||||
;;; DICE-SET.
|
||||
|
||||
(defmethod dice-values ((object dice-set))
|
||||
____)
|
||||
(slot-value object 'dice-values))
|
||||
|
||||
(defmethod roll (count (object dice-set))
|
||||
____)
|
||||
(unless (and (integerp count) (< 0 count)) (signal (make-condition 'type-error
|
||||
:datum count
|
||||
:expected-type 'integer)))
|
||||
(let ((rolls (mapcar (lambda (x) (declare (ignore x)) (+ 1 (random 6))) (make-list count))))
|
||||
(setf (slot-value object 'dice-values) rolls)))
|
||||
|
||||
(roll 5 *my-dice*)
|
||||
|
||||
(define-test make-dice-set
|
||||
(let ((dice (make-instance 'dice-set)))
|
||||
(assert-true (typep dice '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)))
|
||||
|
|
@ -73,21 +82,34 @@
|
|||
(assert-equal 100 (length (roll 100 dice)))
|
||||
(assert-equal 1 (length (roll 1 dice)))))
|
||||
|
||||
;; this is about signaling error, rhg
|
||||
;; but wtf about expected-type being subtype of '(integer 1 6) ???
|
||||
;; shouldn't it be any integer?
|
||||
|
||||
|
||||
|
||||
(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)))))
|
||||
(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)) ; wtf is this?
|
||||
; surely it's got to be just integer?
|
||||
)))
|
||||
(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)))))
|
||||
|
||||
;; (setq dice *my-dice*)
|
||||
;; (dice-failure "0")
|
||||
|
||||
;;; welp. signaling errors is the most unfamiliar thing for me
|
||||
|
|
|
|||
|
|
@ -23,4 +23,4 @@
|
|||
;;; This is a free form assignment, so approach it however you desire.
|
||||
|
||||
(define-test play-greed
|
||||
(assert-true ____))
|
||||
(assert-true t))
|
||||
|
|
|
|||
|
|
@ -23,19 +23,22 @@
|
|||
(cond ((null forms) 'nil)
|
||||
((null (rest forms)) (first forms))
|
||||
(t `(when ,(first forms)
|
||||
,(generate (rest forms)))))))
|
||||
,(generate (rest forms))))))) ; wowy
|
||||
(generate forms)))
|
||||
|
||||
(when (= 2 3) "hello")
|
||||
|
||||
(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 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!"))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
|
@ -43,16 +46,19 @@
|
|||
|
||||
(define-test variable-capture
|
||||
(macrolet ((for ((var start stop) &body body)
|
||||
`(do ((,var ,start (1+ ,var))
|
||||
(limit ,stop))
|
||||
((> ,var limit))
|
||||
,@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)))))
|
||||
(push i result)
|
||||
(assert-equal 3 limit))
|
||||
(assert-equal '(0 1 2 3) (nreverse result))))) ; didn't get it on first tries, ugh
|
||||
;; oh, ok - then try to use names that wouldn't happen in outside condext
|
||||
;; so that explicitly defined things in outside context get overshadowed
|
||||
;; ok
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
|
@ -60,20 +66,23 @@
|
|||
;;; 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)))))
|
||||
;; 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)))))
|
||||
; omg, fuck this guessing
|
||||
; ok, the ,stop was evaluated on each iteraction
|
||||
; to check "whether to stop"
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
|
@ -81,36 +90,53 @@
|
|||
;;; 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)))))
|
||||
(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)))))
|
||||
;; didn't got on first try,
|
||||
;; but yes, for gensym limit ,stop is evaluated first
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(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)))))
|
||||
(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 ((initial (gensym "INITIAL"))
|
||||
(limit (gensym "LIMIT")))
|
||||
`(do* ((,initial ,start)
|
||||
(,limit ,stop)
|
||||
(,var ,initial (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 '(0 3) (nreverse side-effects)))))
|
||||
|
||||
;; (do* ((a (return-0))
|
||||
;; (b (return-3))
|
||||
;; (i a (1+ i)))
|
||||
;; ((> i b))
|
||||
;; (push i result))
|
||||
;;
|
||||
;; so, my mistake was: using DO and trying to cross reference temp vars
|
||||
;; and mistyping 1+ as 1_
|
||||
|
|
|
|||
Loading…
Reference in New Issue