Why is there a difference in behavior between ecase (or case) and ccase in the examples below? ecase is behaving normally, unlike ccase. Tested with SBCL version 2.0.1. I didn't find an explanation after a quick look at the specs (CLTL2).
(ecase 'dos
((i uno) 1)
((ii dos) 2)
((iii tres) 3))
2
(ccase 'dos
((i uno) 1)
((ii dos) 2)
((iii tres) 3))
; in: CCASE 'DOS
; (SETF 'DOS
; (SB-KERNEL:CASE-BODY-ERROR 'CCASE ''DOS #:G680
; '(MEMBER I UNO II DOS III TRES)
; '(I UNO II DOS III TRES)))
; --> LET* FUNCALL
; ==>
; (SB-C::%FUNCALL #'(SETF QUOTE) #:NEW1 #:DOS3)
;
; caught WARNING:
; The function (SETF QUOTE) is undefined, and its name is reserved by ANSI CL so
; that even if it were defined later, the code doing so would not be portable.
; ==>
; (LET* ((#:DOS3 DOS)
; (#:NEW1
; (SB-KERNEL:CASE-BODY-ERROR 'CCASE ''DOS #:G680
; '(MEMBER I UNO II DOS III TRES)
; '(I UNO II DOS III TRES))))
; (FUNCALL #'(SETF QUOTE) #:NEW1 #:DOS3))
;
; caught WARNING:
; undefined variable: COMMON-LISP-USER::DOS
;
; compilation unit finished
; Undefined function:
; (SETF QUOTE)
; Undefined variable:
; DOS
; caught 2 WARNING conditions
2
ccase
needs a place which can store a value, not a value. In other words the first argument to ccase
must be a form which is a valid first argument for setf
.
That's because, in the case where no clause matches, a restartable error is signalled with a store-value
restart which will assign a value to the place which is the first argument, and then retry the whole ccase
form.
'x
is not such a form: you can't say (setf 'x ...)
.
Here is a toy version of ccase
, called continuable-case
which demonstrates what the expansion of ccase
might be. This probably misses things, but it's enough to demonstrate where it stores a value into the place.
(defmacro continuable-case (place &body clauses)
(when (assoc-if (lambda (k) (member k '(otherwise t))) clauses)
(error "can't have a default clause"))
(let ((name (make-symbol "CONTINUABLE-CASE"))
(retry (make-symbol "RETRY"))
(value (make-symbol "VALUE"))
(v (make-symbol "V"))
(expected-type `(member ,@(mapcan (lambda (clause)
(let ((key (first clause)))
(typecase key
(cons
(copy-list key))
(t (list key)))))
clauses))))
`(block ,name
(tagbody
,retry
(return-from ,name
(let ((,value ,place))
(case ,value
,@clauses
(otherwise
(restart-case
(error 'type-error
:datum ,value
:expected-type ',expected-type)
(store-value (,v)
:report "set a new value and retry"
:interactive (lambda ()
(format *query-io* "~&new value: ")
(finish-output *query-io*)
(list (read *query-io*)))
(setf ,place ,v)
(go ,retry)))))))))))