common-lispsbcl

Unexpected behavior of CCASE in SBCL (compared to CASE and ECASE)


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

Solution

  • 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)))))))))))