X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fconstantp.lisp;h=85bb5b8f5f9f6037e31ab0446270875584d4831a;hb=faafcfc8d751c0f549f8d30ff2ea4bc7342a7329;hp=29252c2ae5c8634647ca18365e6b271cd81312ad;hpb=1b7893730f82deb30161b3065a611774a02b2d66;p=sbcl.git diff --git a/src/compiler/constantp.lisp b/src/compiler/constantp.lisp index 29252c2..85bb5b8 100644 --- a/src/compiler/constantp.lisp +++ b/src/compiler/constantp.lisp @@ -40,7 +40,7 @@ (list (or (constant-special-form-p form environment envp) #-sb-xc-host - (constant-function-call-p form environment envp))) + (values (constant-function-call-p form environment envp)))) (t t)))) (defun %constant-form-value (form environment envp) @@ -76,21 +76,21 @@ ;;; too. (defun constant-function-call-p (form environment envp) (let ((name (car form))) - (and (legal-fun-name-p name) - (eq :function (info :function :kind name)) - (let ((info (info :function :info name))) - (and info (ir1-attributep (fun-info-attributes info) - foldable))) - (and (every (lambda (arg) - (%constantp arg environment envp)) - (cdr form)) - ;; Even though the function may be marked as foldable - ;; the call may still signal an error -- eg: (CAR 1). - (handler-case - (progn - (constant-function-call-value form environment envp) - t) - (error () nil)))))) + (if (and (legal-fun-name-p name) + (eq :function (info :function :kind name)) + (let ((info (info :function :info name))) + (and info (ir1-attributep (fun-info-attributes info) + foldable))) + (and (every (lambda (arg) + (%constantp arg environment envp)) + (cdr form)))) + ;; Even though the function may be marked as foldable + ;; the call may still signal an error -- eg: (CAR 1). + (handler-case + (values t (constant-function-call-value form environment envp)) + (error () + (values nil nil))) + (values nil nil)))) (defun constant-function-call-value (form environment envp) (apply (fdefinition (car form))