(define-syntax cc
  (syntax-rules ()
    ((_ ?checked-expression ?clauses ...)
     (letrec-syntax
         ((cc-internal
           (macro-rules ()
            ((_ ?recur ?catchall ?exn ?kvar)
              (if ?catchall `(void) `(##sys#signal ,?exn)))
             ((_ ?recur ?catchall ?exn ?kvar ?clause . ?rest)
              (bind-case ?clause
                ((?var () ?body)
                 (if (not (null? ?rest))
                     (##sys#notice
                      "clauses following catch-all clause in condition-case"
                      `(,?var () ,?body)))
                 `(if #t
                      (let ((,?var ,?exn)) ,?body)
                      (,?recur ,?recur #t ,?exn ,?kvar . ,?rest)))
                ((() ?body)
                 (if (not (null? ?rest))
                   (##sys#notice
                    "clauses following catch-all clause in condition-case"
                    `(() ,?body)))
                 `(if #t
                      ,?body
                      (,?recur ,?recur #t ,?exn ,?kvar . ,?rest)))
                ((?var ?kinds ?body)
                 `(if (and ,?kvar ,@(map (lambda (k) `(memv ',k ,?kvar)) ?kinds))
                      (let ((,?var ,?exn)) ,?body)
                      (,?recur ,?recur ,?catchall ,?exn ,?kvar . ,?rest)))
                ((?kinds ?body)
                 `(if (and ,?kvar ,@(map (lambda (k) `(memv ',k ,?kvar)) ?kinds))
                      ,?body
                      (,?recur ,?recur ,?catchall ,?exn ,?kvar . ,?rest))))))))
      (handle-exceptions exn
          (let ((kvar (and (##sys#structure? exn 'condition)
                           (##sys#slot exn 1))))
            (cc-internal cc-internal #f exn kvar ?clauses ...))
        ?checked-expression)))))