Function: byte-compile-condition-case

byte-compile-condition-case is a byte-compiled function defined in bytecomp.el.gz.

Signature

(byte-compile-condition-case FORM)

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/bytecomp.el.gz
(defun byte-compile-condition-case (form)
  (let* ((var (nth 1 form))
         (body (nth 2 form))
         (handlers (nthcdr 3 form))
         (depth byte-compile-depth)
         (success-handler (assq :success handlers))
         (failure-handlers (if success-handler
                               (remq success-handler handlers)
                             handlers))
         (clauses (mapcar (lambda (clause)
                            (cons (byte-compile-make-tag) clause))
                          failure-handlers))
         (endtag (byte-compile-make-tag)))
    (unless (symbolp var)
      (byte-compile-warn-x
       var "`%s' is not a variable-name or nil (in condition-case)" var))

    (dolist (clause (reverse clauses))
      (let ((condition (nth 1 clause)))
        (when (and (eq (car-safe condition) 'quote)
                   (cdr condition) (null (cddr condition)))
          (byte-compile-warn-x
           condition "`condition-case' condition should not be quoted: %S"
           condition))
        (when (and (consp condition) (memq :success condition))
          (byte-compile-warn-x
           condition
           "`:success' must be the first element of a `condition-case' handler"))
        (unless (consp condition) (setq condition (list condition)))
        (dolist (c condition)
          (unless (and c (symbolp c))
            (byte-compile-warn-x
             c "`%S' is not a condition name (in condition-case)" c))
          ;; In reality, the `error-conditions' property is only required
          ;; for the argument to `signal', not to `condition-case'.
          ;;(unless (consp (get c 'error-conditions))
          ;;  (byte-compile-warn
          ;;   "`%s' is not a known condition name (in condition-case)"
          ;;   c))
          )
        (byte-compile-push-constant condition))
      (byte-compile-goto 'byte-pushconditioncase (car clause)))

    (byte-compile-form body) ;; byte-compile--for-effect
    (dolist (_ clauses) (byte-compile-out 'byte-pophandler))

    (let ((compile-handler-body
           (lambda (body)
             (let ((byte-compile-bound-variables byte-compile-bound-variables)
                   (byte-compile--lexical-environment
                    byte-compile--lexical-environment))
               (cond
                ((null var) (byte-compile-discard))
                (lexical-binding
                 (push (cons var (1- byte-compile-depth))
                       byte-compile--lexical-environment))
                (t (byte-compile-dynamic-variable-bind var)))

               (byte-compile-body body) ;; byte-compile--for-effect

               (cond
                ((null var))
                (lexical-binding (byte-compile-discard 1 'preserve-tos))
                (t (byte-compile-out 'byte-unbind 1)))))))

      (when success-handler
        (funcall compile-handler-body (cdr success-handler)))

      (byte-compile-goto 'byte-goto endtag)

      (while clauses
        (let ((clause (pop clauses)))
          (setq byte-compile-depth (1+ depth))
          (byte-compile-out-tag (pop clause))
          (dolist (_ clauses) (byte-compile-out 'byte-pophandler))
          (funcall compile-handler-body (cdr clause))
          (byte-compile-goto 'byte-goto endtag)))

      (byte-compile-out-tag endtag))))