Function: cond*-convert-condition
cond*-convert-condition is a byte-compiled function defined in
cond-star.el.gz.
Signature
(cond*-convert-condition CONDITION TRUE-EXPS UNCONDIT-CLAUSES REST IFFALSE)
Documentation
Process the condition part of one cond* clause.
TRUE-EXPS is a list of Lisp expressions to be executed if this condition is true, and inside its bindings. UNCONDIT-CLAUSES is a list of cond*-clauses to be executed if this condition is true, and inside its bindings. This is used for non-exit clauses; it is nil for conditional-exit clauses.
REST and IFFALSE are non-nil for conditional-exit clauses that are not final. REST is a list of clauses to process after this one if this one could have exited but does not exit. This is used for conditional exit clauses. IFFALSE is the value to compute after this one if this one could have exited but does not exit. This is used for conditional exit clauses.
Source Code
;; Defined in /usr/src/emacs/lisp/emacs-lisp/cond-star.el.gz
(defun cond*-convert-condition (condition true-exps uncondit-clauses rest iffalse)
"Process the condition part of one cond* clause.
TRUE-EXPS is a list of Lisp expressions to be executed if this
condition is true, and inside its bindings.
UNCONDIT-CLAUSES is a list of cond*-clauses to be executed if this
condition is true, and inside its bindings.
This is used for non-exit clauses; it is nil for conditional-exit clauses.
REST and IFFALSE are non-nil for conditional-exit clauses that are not final.
REST is a list of clauses to process after this one if
this one could have exited but does not exit.
This is used for conditional exit clauses.
IFFALSE is the value to compute after this one if
this one could have exited but does not exit.
This is used for conditional exit clauses."
(if (and uncondit-clauses rest)
(error "Clause is both exiting and non-exit"))
(let ((pat-type (car-safe condition)))
(cond ((eq pat-type 'bind*)
(let* ((bindings (cdr condition))
(first-binding (car bindings))
(first-variable (if (symbolp first-binding) first-binding
(car first-binding)))
(first-value (if (symbolp first-binding) nil
(cadr first-binding)))
(init-gensym (gensym "init"))
;; BINDINGS with the initial value of the first binding
;; replaced by INIT-GENSYM.
(mod-bindings
(cons (list first-variable init-gensym) (cdr bindings))))
;;; ??? Here pull out all nontrivial initial values
;;; ??? to compute them earlier.
(if rest
;; bind* starts an exiting clause which is not final.
;; Therefore, must run IFFALSE.
`(let ((,init-gensym ,first-value))
(if ,init-gensym
(let* ,mod-bindings
. ,true-exps)
;; Always calculate all bindings' initial values,
;; but the bindings must not cover IFFALSE.
(let* ,mod-bindings nil)
,iffalse))
(if uncondit-clauses
;; bind* starts a non-exit clause which is not final.
;; Run the TRUE-EXPS if condition value is true.
;; Then always go on to run the UNCONDIT-CLAUSES.
(if true-exps
`(let ((,init-gensym ,first-value))
;;; ??? Should we make the bindings a second time for the UNCONDIT-CLAUSES.
;;; as the doc string says, for uniformity with match*?
(let* ,mod-bindings
(when ,init-gensym
. ,true-exps)
,(cond*-convert uncondit-clauses)))
`(let* ,bindings
,(cond*-convert uncondit-clauses)))
;; bind* starts a final clause.
;; If there are TRUE-EXPS, run them if condition succeeded.
;; Always make the bindings, in case the
;; initial values have side effects.
`(let ((,init-gensym ,first-value))
;; Calculate all binding values unconditionally.
(let* ,mod-bindings
(when ,init-gensym
. ,true-exps)))))))
((eq pat-type 'bind-and*)
(let ((checks '()) (last t))
(dolist (bind (cdr condition))
(push (list (car bind) (list 'and last (cadr bind)))
checks)
(when (eq (caar checks) '_)
(setcar (car checks) (make-symbol "s")))
(setq last (caar checks)))
(cond
;; For explanations on these cases, see "Ordinary
;; Lisp expression is the condition." below.
(rest
(let ((quit (gensym "quit")))
`(catch ',quit
(let* (,@(nreverse checks))
(if ,last (throw ',quit ,(macroexp-progn true-exps))))
,iffalse)))
(uncondit-clauses
`(progn
(let* (,@(nreverse checks))
(if ,last ,(macroexp-progn true-exps)))
,(cond*-convert uncondit-clauses)))
(true-exps
`(let* (,@(nreverse checks))
(if ,last ,(macroexp-progn true-exps))))
(t last))))
((eq pat-type 'pcase*)
(if true-exps
(progn
(when uncondit-clauses
;; FIXME: This happens in cases like
;; (cond* ((match* `(,x . ,y) EXP) THEN :non-exit)
;; (t ELSE))
;; where ELSE is supposed to run after THEN also (and
;; with access to `x' and `y').
(error ":non-exit not supported with `pcase*'"))
(cl-assert (or (null iffalse) rest))
`(pcase ,(nth 2 condition)
(,(nth 1 condition) ,@true-exps)
(_ ,iffalse)))
(cl-assert (null iffalse))
(cl-assert (null rest))
`(pcase-let ((,(nth 1 condition) ,(nth 2 condition)))
(cond* . ,uncondit-clauses))))
((eq pat-type 'match*)
(cond*-match condition true-exps uncondit-clauses iffalse))
(t
;; Ordinary Lisp expression is the condition.
(if rest
;; A nonfinal exiting clause.
;; If condition succeeds, run the TRUE-EXPS.
;; There are following clauses, so run IFFALSE
;; if the condition fails.
`(if ,condition
(progn . ,true-exps)
,iffalse)
(if uncondit-clauses
;; A non-exit clause.
;; If condition succeeds, run the TRUE-EXPS.
;; Then always go on to run the UNCONDIT-CLAUSES.
`(progn (if ,condition
(progn . ,true-exps))
,(cond*-convert uncondit-clauses))
;; An exiting clause which is also final.
;; If there are TRUE-EXPS, run them if CONDITION succeeds.
(if true-exps
`(if ,condition (progn . ,true-exps))
;; Run and return CONDITION.
condition)))))))