#!+sb-doc
"IF predicate then [else]
-If PREDICATE evaluates to false, evaluate THEN and return its values,
+If PREDICATE evaluates to true, evaluate THEN and return its values,
otherwise evaluate ELSE and return its values. ELSE defaults to NIL."
(let* ((pred-ctran (make-ctran))
(pred-lvar (make-lvar))
\f
;;;; FUNCTION and NAMED-LAMBDA
(defun name-lambdalike (thing)
- (ecase (car thing)
+ (case (car thing)
((named-lambda)
(or (second thing)
`(lambda ,(third thing))))
- ((lambda instance-lambda)
+ ((lambda)
`(lambda ,(second thing)))
((lambda-with-lexenv)
- `(lambda ,(fifth thing)))))
+ `(lambda ,(fifth thing)))
+ (otherwise
+ (compiler-error "Not a valid lambda expression:~% ~S"
+ thing))))
(defun fun-name-leaf (thing)
(if (consp thing)
(cond
((member (car thing)
- '(lambda named-lambda instance-lambda lambda-with-lexenv))
+ '(lambda named-lambda lambda-with-lexenv))
(values (ir1-convert-lambdalike
thing
:debug-name (name-lambdalike thing))
(varify-lambda-arg name
(if (eq context 'let*)
nil
- (names)))))
+ (names))
+ context)))
(dolist (spec bindings)
(cond ((atom spec)
(let ((var (get-var spec)))
;; ,CLEANUP-FUN should probably be declared DYNAMIC-EXTENT,
;; and something can be done to make %ESCAPE-FUN have
;; dynamic extent too.
+ (declare (dynamic-extent #',cleanup-fun))
(block ,drop-thru-tag
(multiple-value-bind (,next ,start ,count)
(block ,exit-tag