* To know that a function call is a constant we need to check that
it doesn't signal an error in addition to knowing that the function
is foldable.
* To know that a THE form is constant we need to check that the
value is of the right type and be prepared to deal with malformed
type specifiers.
* Tests, tests, tests.
...all in all, I'm starting to miss the evaluator branch.
the right fix is to remove the abstraction violation in the
compiler's type deriver.
the right fix is to remove the abstraction violation in the
compiler's type deriver.
-392: slot-accessor for subclass misses obsoleted superclass
- (fixed in sbcl-0.9.7.9)
-
393: Wrong error from methodless generic function
(DEFGENERIC FOO (X))
(FOO 1 2)
393: Wrong error from methodless generic function
(DEFGENERIC FOO (X))
(FOO 1 2)
For some more details see comments for (define-alien-type-method
(c-string :deport-gen) ...) in host-c-call.lisp.
For some more details see comments for (define-alien-type-method
(c-string :deport-gen) ...) in host-c-call.lisp.
-399: LOOP FOR ACROSS and full call to DATA-VECTOR-REF
- (fixed in sbcl-0.9.9.x)
-
400: "aggressive constant folding"
400: "aggressive constant folding"
- (compile nil '(lambda () (or t (the integer (/ 1 0)))))
- signals an error.
+ (fixed in sbcl-0.9.10.17)
+
(let ((info (info :function :info name)))
(and info (ir1-attributep (fun-info-attributes info)
foldable)))
(let ((info (info :function :info name)))
(and info (ir1-attributep (fun-info-attributes info)
foldable)))
- (every (lambda (arg)
- (%constantp arg environment envp))
- (cdr form)))))
+ (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))))))
(defun constant-function-call-value (form environment envp)
(apply (fdefinition (car form))
(defun constant-function-call-value (form environment envp)
(apply (fdefinition (car form))
:test (every #'constantp* (cons protected-form cleanup-forms))
:eval (constant-form-value* protected-form))
:test (every #'constantp* (cons protected-form cleanup-forms))
:eval (constant-form-value* protected-form))
- (defconstantp the (value-type form)
- :test (constantp* form)
- :eval (let ((value (constant-form-value* form)))
- (if (typep value value-type)
- value
- (error 'type-error
- :datum value
- :expected-type value-type))))
+ (defconstantp the (type form)
+ :test (and (constantp* form)
+ (handler-case
+ ;; in case the type-spec is malformed!
+ (typep (constant-form-value* form) type)
+ (error () nil)))
+ :eval (constant-form-value* form))
(defconstantp block (name &body forms)
;; We currently fail to detect cases like
(defconstantp block (name &body forms)
;; We currently fail to detect cases like
(space 2) (safety 0) (compilation-speed 0)))
(unwind-protect 0
(* (/ (multiple-value-prog1 -29457482 -5602513511) 1))))))))
(space 2) (safety 0) (compilation-speed 0)))
(unwind-protect 0
(* (/ (multiple-value-prog1 -29457482 -5602513511) 1))))))))
+
+;; aggressive constant folding (bug #400)
+(assert
+ (eq t (funcall (compile nil '(lambda () (or t (the integer (/ 1 0))))))))
((the integer 1) t 1)
((the integer (+ 1 1)) t 2)
((the integer (foo)) nil)
((the integer 1) t 1)
((the integer (+ 1 1)) t 2)
((the integer (foo)) nil)
+ ((the symbol 1) nil)
+ ((the "bad type" 1) nil)
+ ((multiple-value-prog1
+ (+ 1 1)
+ :nada) t 2)
+ ((multiple-value-prog1
+ :nada
+ (/ 1 0)) nil)
+ ((/ 1 0) nil)
+ ((/ 1 1) t 1)
((+ 1 2) t 3)))
(destructuring-bind (form c &optional v) test
(assert (eql (constantp form) c))
((+ 1 2) t 3)))
(destructuring-bind (form c &optional v) test
(assert (eql (constantp form) c))
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)