* optimization: calling functions via constant symbols -- as in
(FUNCALL 'FOO) -- is now roughly as efficient as calling them
via the function object as in (FUNCALL #'FOO).
+ * enhancement: CONSTANTP is now able to determine constantness of
+ more complex forms, including calls to constant-foldable standardized
+ functions and some special forms beyond QUOTE.
changes in sbcl-0.9.10 relative to sbcl-0.9.9:
* new feature: new SAVE-LISP-AND-DIE keyword argument :EXECUTABLE can
;; defines IR1-ATTRIBUTES macro, needed by proclaim.lisp
("src/compiler/knownfun")
+ ("src/compiler/constantp")
;; needs FUN-INFO structure slot setters, defined in knownfun.lisp
("src/compiler/fun-info-funs")
"INFO"
"MAKE-INFO-ENVIRONMENT"
+ ;; Constant form evaluation
+ "CONSTANT-FORM-VALUE"
+ "CONSTANT-TYPEP"
+
;; stepping control
"*STEPPING*" "*STEP*"
"!VM-TYPE-COLD-INIT" "!BACKQ-COLD-INIT"
"!SHARPM-COLD-INIT" "!EARLY-PROCLAIM-COLD-INIT"
"!LATE-PROCLAIM-COLD-INIT" "!CLASS-FINALIZE"
+ "!CONSTANTP-COLD-INIT"
"GC-REINIT"
"SIGNAL-COLD-INIT-OR-REINIT"
(show-and-call !policy-cold-init-or-resanify)
(/show0 "back from !POLICY-COLD-INIT-OR-RESANIFY")
+ (show-and-call !constantp-cold-init)
(show-and-call !early-proclaim-cold-init)
;; KLUDGE: Why are fixups mixed up with toplevel forms? Couldn't
:initform-p ',initform-p
:documentation ',documentation
:initform
- ,(if (constantp initform)
- `',(eval initform)
+ ,(if (sb!xc:constantp initform)
+ `',(constant-form-value initform)
`#'(lambda () ,initform)))))))
(dolist (option options)
(let ((val (second initargs)))
(setq default-initargs
(list* `',(first initargs)
- (if (constantp val)
- `',(eval val)
+ (if (sb!xc:constantp val)
+ `',(constant-form-value val)
`#'(lambda () ,val))
default-initargs)))))
(t
(let ((,count-name 0))
(declare (type index ,count-name) (ignorable ,count-name))
,@(when (and (or prefixp per-line-prefix-p)
- (not (and (sb!xc:constantp (or prefix per-line-prefix) env)
- ;; KLUDGE: EVAL-IN-ENV would
- ;; be useful here.
- (typep (eval (or prefix per-line-prefix)) 'string))))
+ (not (sb!int:constant-typep
+ (or prefix per-line-prefix)
+ 'string
+ env)))
`((unless (typep ,(or prefix per-line-prefix) 'string)
(error 'type-error
:datum ,(or prefix per-line-prefix)
:expected-type 'string))))
,@(when (and suffixp
- (not (and (sb!xc:constantp suffix env)
- (typep (eval suffix) 'string))))
+ (not (sb!int:constant-typep suffix 'string env)))
`((unless (typep ,suffix 'string)
(error 'type-error
:datum ,suffix
;;;; code analysis stuff
(defun loop-constant-fold-if-possible (form &optional expected-type)
- (let ((new-form form) (constantp nil) (constant-value nil))
- (when (setq constantp (constantp new-form))
- (setq constant-value (eval new-form)))
+ (let* ((constantp (sb!xc:constantp form))
+ (value (and constantp (sb!int:constant-form-value form))))
(when (and constantp expected-type)
- (unless (sb!xc:typep constant-value expected-type)
+ (unless (sb!xc:typep value expected-type)
(loop-warn "~@<The form ~S evaluated to ~S, which was not of ~
the anticipated type ~S.~:@>"
- form constant-value expected-type)
- (setq constantp nil constant-value nil)))
- (values new-form constantp constant-value)))
-
-(defun loop-constantp (form)
- (constantp form))
+ form value expected-type)
+ (setq constantp nil value nil)))
+ (values form constantp value)))
\f
;;;; LOOP iteration optimization
-(defvar *loop-duplicate-code*
- nil)
+(defvar *loop-duplicate-code* nil)
-(defvar *loop-iteration-flag-var*
- (make-symbol "LOOP-NOT-FIRST-TIME"))
+(defvar *loop-iteration-flag-var* (make-symbol "LOOP-NOT-FIRST-TIME"))
(defun loop-code-duplication-threshold (env)
(declare (ignore env))
(t (error "invalid LOOP variable passed in: ~S" name))))
(defun loop-maybe-bind-form (form data-type)
- (if (loop-constantp form)
+ (if (constantp form)
form
(loop-make-var (gensym "LOOP-BIND-") form data-type)))
\f
(when (constantp size)
(setf alien-type (copy-alien-array-type alien-type))
(setf (alien-array-type-dimensions alien-type)
- (cons (eval size) (cdr dims)))))
+ (cons (constant-form-value size) (cdr dims)))))
(dims
(setf size (car dims)))
(t
--- /dev/null
+;;;; implementation of CONSTANTP, needs both INFO and IR1-ATTRIBUTES
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+
+(in-package "SB!C")
+
+(!begin-collecting-cold-init-forms)
+
+(defvar *special-form-constantp-funs*)
+(declaim (type hash-table *special-form-constantp-funs*))
+(!cold-init-forms
+ (setf *special-form-constantp-funs* (make-hash-table)))
+
+(defvar *special-form-constant-form-value-funs*)
+(declaim (type hash-table *special-form-constant-form-value-funs*))
+(!cold-init-forms
+ (setf *special-form-constant-form-value-funs* (make-hash-table)))
+
+(defvar *special-constant-variables*)
+(!cold-init-forms
+ (setf *special-constant-variables* nil))
+
+(defun %constantp (form environment envp)
+ (let ((form (if envp
+ (sb!xc:macroexpand form environment)
+ form)))
+ (typecase form
+ ;; This INFO test catches KEYWORDs as well as explicitly
+ ;; DEFCONSTANT symbols.
+ (symbol
+ (or (eq (info :variable :kind form) :constant)
+ (constant-special-variable-p form)))
+ (list
+ (or (constant-special-form-p form environment envp)
+ #-sb-xc-host
+ (constant-function-call-p form environment envp)))
+ (t t))))
+
+(defun %constant-form-value (form environment envp)
+ (let ((form (if envp
+ (sb!xc:macroexpand form environment)
+ form)))
+ (typecase form
+ (symbol
+ (symbol-value form))
+ (list
+ (if (special-operator-p (car form))
+ (constant-special-form-value form environment envp)
+ #-sb-xc-host
+ (constant-function-call-value form environment envp)))
+ (t
+ form))))
+
+(defun constant-special-form-p (form environment envp)
+ (let ((fun (gethash (car form) *special-form-constantp-funs*)))
+ (when fun
+ (funcall fun form environment envp))))
+
+(defun constant-special-form-value (form environment envp)
+ (let ((fun (gethash (car form) *special-form-constant-form-value-funs*)))
+ (if fun
+ (funcall fun form environment envp)
+ (error "Not a constant-foldable special form: ~S" form))))
+
+(defun constant-special-variable-p (name)
+ (and (member name *special-constant-variables*) t))
+
+;;; FIXME: It would be nice to deal with inline functions
+;;; 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)))
+ (every (lambda (arg)
+ (%constantp arg environment envp))
+ (cdr form)))))
+
+(defun constant-function-call-value (form environment envp)
+ (apply (fdefinition (car form))
+ (mapcar (lambda (arg)
+ (%constant-form-value arg environment envp))
+ (cdr form))))
+
+#!-sb-fluid (declaim (inline sb!xc:constantp))
+(defun sb!xc:constantp (form &optional (environment nil envp))
+ #!+sb-doc
+ "True of any FORM that has a constant value: self-evaluating objects,
+keywords, defined constants, quote forms. Additionally the
+constant-foldability of some function calls special forms is recognized. If
+ENVIRONMENT is provided the FORM is first macroexpanded in it."
+ (%constantp form environment envp))
+
+#!-sb-fluid (declaim (inline constant-form-value))
+(defun constant-form-value (form &optional (environment nil envp))
+ #!+sb-doc
+ "Returns the value of the constant FORM in ENVIRONMENT. Behaviour
+is undefined unless CONSTANTP has been first used to determine the
+constantness of the FORM in ENVIRONMENT."
+ (%constant-form-value form environment envp))
+
+(declaim (inline constant-typep))
+(defun constant-typep (form type &optional (environment nil envp))
+ (and (%constantp form environment envp)
+ ;; FIXME: We probably should be passing the environment to
+ ;; TYPEP too, but (1) our XC version of typep AVERs that the
+ ;; environment is null (2) our real version ignores it anyhow.
+ (sb!xc:typep (%constant-form-value form environment envp) type)))
+
+;;;; NOTE!!!
+;;;;
+;;;; If you add new special forms, check that they do not
+;;;; alter the logic of existing ones: eg, currently
+;;;; CONSTANT-FORM-VALUE directly evaluates the last expression
+;;;; of a PROGN, as no assignment is allowed. If you extend
+;;;; analysis to assignments then other forms must take this
+;;;; into account.
+
+(defmacro defconstantp (operator lambda-list &key test eval)
+ (with-unique-names (form environment envp)
+ (flet ((frob (body)
+ `(flet ((constantp* (x)
+ (%constantp x ,environment ,envp))
+ (constant-form-value* (x)
+ (%constant-form-value x ,environment ,envp)))
+ (declare (ignorable #'constantp* #'constant-form-value*))
+ (destructuring-bind ,lambda-list (cdr ,form)
+ ;; KLUDGE: is all we need, so we keep it simple
+ ;; instead of general (not handling cases like &key (x y))
+ (declare (ignorable
+ ,@(remove-if (lambda (arg)
+ (member arg lambda-list-keywords))
+ lambda-list)))
+ ,body))))
+ `(progn
+ (setf (gethash ',operator *special-form-constantp-funs*)
+ (lambda (,form ,environment ,envp)
+ ,(frob test)))
+ (setf (gethash ',operator *special-form-constant-form-value-funs*)
+ (lambda (,form ,environment ,envp)
+ ,(frob eval)))))))
+
+(!cold-init-forms
+ (defconstantp quote (value)
+ :test t
+ :eval value)
+
+ (defconstantp if (test then &optional else)
+ :test
+ (and (constantp* test)
+ (constantp* (if (constant-form-value* test)
+ then
+ else)))
+ :eval (if (constant-form-value* test)
+ (constant-form-value* then)
+ (constant-form-value* else)))
+
+ (defconstantp progn (&body forms)
+ :test (every #'constantp* forms)
+ :eval (constant-form-value* (car (last forms))))
+
+ (defconstantp unwind-protect (protected-form &body cleanup-forms)
+ :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 block (name &body forms)
+ ;; We currently fail to detect cases like
+ ;;
+ ;; (BLOCK FOO
+ ;; ...CONSTANT-FORMS...
+ ;; (RETURN-FROM FOO CONSTANT-VALUE)
+ ;; ...ANYTHING...)
+ ;;
+ ;; Right now RETURN-FROM kills the constantness unequivocally.
+ :test (every #'constantp* forms)
+ :eval (constant-form-value* (car (last forms))))
+
+ (defconstantp multiple-value-prog1 (first-form &body forms)
+ :test (every #'constantp* (cons first-form forms))
+ :test (constant-form-value* first-form))
+
+ (defconstantp progv (symbols values &body forms)
+ :test (and (constantp* symbols)
+ (constantp* values)
+ (let ((*special-constant-variables*
+ (append (constant-form-value* symbols)
+ *special-constant-variables*)))
+ (every #'constantp* forms)))
+ :eval (progv
+ (constant-form-value* symbols)
+ (constant-form-value* values)
+ (constant-form-value* (car (last forms))))))
+
+(!defun-from-collected-cold-init-forms !constantp-cold-init)
+
;;;; ANSI Common Lisp functions which are defined in terms of the info
;;;; database
-(defun sb!xc:constantp (object &optional environment)
- #!+sb-doc
- "True of any Lisp object that has a constant value: types that eval to
- themselves, keywords, constants, and list whose car is QUOTE."
- ;; FIXME: Someday it would be nice to make the code recognize foldable
- ;; functions and call itself recursively on their arguments, so that
- ;; more of the examples in the ANSI CL definition are recognized.
- ;; (e.g. (+ 3 2), (SQRT PI), and (LENGTH '(A B C)))
- (declare (ignore environment))
- (typecase object
- ;; (Note that the following test on INFO catches KEYWORDs as well as
- ;; explicitly DEFCONSTANT symbols.)
- (symbol (eq (info :variable :kind object) :constant))
- (list (and (eq (car object) 'quote)
- (consp (cdr object))))
- (t t)))
-
-(defun constant-form-value (form)
- (typecase form
- (symbol (info :variable :constant-value form))
- ((cons (eql quote) cons)
- (second form))
- (t form)))
-
(defun sb!xc:macro-function (symbol &optional env)
#!+sb-doc
"If SYMBOL names a macro in ENV, returns the expansion function,
(with-fun-name-leaf (leaf thing start :global t)
(reference-leaf start next result leaf)))
-(defun constant-global-fun-name-p (thing)
- ;; FIXME: Once we have a marginally better CONSTANTP and
- ;; CONSTANT-VALUE we can use those instead.
- (and (consp thing)
- (eq 'quote (car thing))
- (null (cddr thing))
- (legal-fun-name-p (cadr thing))
- t))
+(defun constant-global-fun-name (thing)
+ (let ((constantp (sb!xc:constantp thing)))
+ (and constantp
+ (let ((name (constant-form-value thing)))
+ (and (legal-fun-name-p name) name)))))
\f
;;;; FUNCALL
;;; directly to %FUNCALL, instead of waiting around for type
;;; inference.
(define-source-transform funcall (function &rest args)
- (cond ((and (consp function) (eq (car function) 'function))
- `(%funcall ,function ,@args))
- ((constant-global-fun-name-p function)
- `(%funcall (global-function ,(second function)) ,@args))
- (t
- (values nil t))))
+ (if (and (consp function) (eq (car function) 'function))
+ `(%funcall ,function ,@args)
+ (let ((name (constant-global-fun-name function)))
+ (if name
+ `(%funcall (global-function ,name) ,@args)
+ (values nil t)))))
(deftransform %coerce-callable-to-fun ((thing) (function) *)
"optimize away possible call to FDEFINITION at runtime"
;; MV-COMBINATIONS.
(make-combination fun-lvar))))
(ir1-convert start ctran fun-lvar
- (cond ((and (consp fun) (eq (car fun) 'function))
- fun)
- ((constant-global-fun-name-p fun)
- `(global-function ,(second fun)))
- (t
- `(%coerce-callable-to-fun ,fun))))
+ (if (and (consp fun) (eq (car fun) 'function))
+ fun
+ (let ((name (constant-global-fun-name fun)))
+ (if name
+ `(global-function ,name)
+ `(%coerce-callable-to-fun ,fun)))))
(setf (lvar-dest fun-lvar) node)
(collect ((arg-lvars))
(let ((this-start ctran))
(if (consp s)
(and (eq (car s) 'eql)
(constantp (cadr s))
- (let ((sv (eval (cadr s))))
+ (let ((sv (constant-form-value (cadr s))))
(or (interned-symbol-p sv)
(integerp sv)
(and (characterp sv)
(constant-value-p (and (null (cdr real-body))
(constantp (car real-body))))
(constant-value (and constant-value-p
- (eval (car real-body))))
+ (constant-form-value (car real-body))))
(plist (and constant-value-p
(or (typep constant-value
'(or number character))
;; broken if RESTP evaluates to a non-self-evaluating form. E.g. if
;; (INVOKE-EFFECTIVE-METHOD-FUNCTION EMF '(ERROR "gotcha") ...)
;; then TRACE-EMF-CALL-CALL-INTERNAL might die on a gotcha error.
- (setq restp (eval restp))
+ (setq restp (constant-form-value restp))
`(progn
(trace-emf-call ,emf ,restp (list ,@required-args+rest-arg))
(cond ((typep ,emf 'fast-method-call)
(defun constant-symbol-p (form)
(and (constantp form)
- (let ((constant (eval form)))
+ (let ((constant (constant-form-value form)))
(and (symbolp constant)
(not (null (symbol-package constant)))))))
(loop for (key . more) on args by #'cddr do
(when (or (null more)
(not (constant-symbol-p key))
- (eq :allow-other-keys (eval key)))
+ (eq :allow-other-keys (constant-form-value key)))
(return-from make-instance->constructor-call nil)))))
(check-class)
(check-args)
;; VALUE-FORMS.
(multiple-value-bind (initargs value-forms)
(loop for (key value) on args by #'cddr and i from 0
- collect (eval key) into initargs
+ collect (constant-form-value key) into initargs
if (constantp value)
collect value into initargs
else
and collect value into value-forms
finally
(return (values initargs value-forms)))
- (let* ((class-name (eval class-name))
+ (let* ((class-name (constant-form-value class-name))
(function-name (make-ctor-function-name class-name initargs)))
;; Prevent compiler warnings for calling the ctor.
(proclaim-as-fun-name function-name)
`(when (eq (clos-slots-ref .slots. ,i)
+slot-unbound+)
(setf (clos-slots-ref .slots. ,i)
- ',(eval value)))
+ ',(constant-form-value value)))
`(setf (clos-slots-ref .slots. ,i)
- ',(eval value))))
+ ',(constant-form-value value))))
(constant
- `(setf (clos-slots-ref .slots. ,i) ',(eval value)))))))
+ `(setf (clos-slots-ref .slots. ,i)
+ ',(constant-form-value value)))))))
;; we are not allowed to modify QUOTEd locations, so we can't
;; generate code like (setf (cdr ',location) arg). Instead,
;; we have to do (setf (cdr .L0.) arg) and arrange for .L0. to
collect location into locations
collect `(setf (cdr ,name)
,(case type
- (constant `',(eval value))
+ (constant `',(constant-form-value value))
((param var) `,value)
(initfn `(funcall ,value))))
into class-init-forms
:format-arguments (list ',name))))
required-checks))
(loop (unless (and (constantp order)
- (neq order (setq order (eval order))))
+ (neq order (setq order
+ (constant-form-value order))))
(return t)))
(push (cond ((eq order :most-specific-first)
`(setq ,name (nreverse ,name)))
(compute-constants lambda constant-converter)))
(defun default-constantp (form)
- (and (constantp form)
- (not (typep (eval form) '(or symbol fixnum)))))
+ (constant-typep form '(not (or symbol fixnum))))
(defun default-test-converter (form)
(if (default-constantp form)
(defun default-constant-converter (form)
(if (default-constantp form)
- (list (eval form))
+ (list (constant-form-value form))
nil))
\f
;;; *FGENS* is a list of all the function generators we have so far. Each
symbol &optional (errorp t) environment)
(declare (ignore environment))
(if (and (constantp symbol)
- (legal-class-name-p (eval symbol))
+ (legal-class-name-p (setf symbol (constant-form-value symbol)))
(constantp errorp)
(member *boot-state* '(braid complete)))
- (let ((symbol (eval symbol))
- (errorp (not (null (eval errorp))))
+ (let ((errorp (not (null (constant-form-value errorp))))
(class-cell (make-symbol "CLASS-CELL")))
`(let ((,class-cell (load-time-value (find-class-cell ',symbol))))
(or (find-class-cell-class ,class-cell)
(defmacro accessor-slot-value (object slot-name)
(aver (constantp slot-name))
- (let* ((slot-name (eval slot-name))
+ (let* ((slot-name (constant-form-value slot-name))
(reader-name (slot-reader-name slot-name)))
`(let ((.ignore. (load-time-value
(ensure-accessor 'reader ',reader-name ',slot-name))))
(aver (constantp slot-name))
(setq object (macroexpand object env))
(setq slot-name (macroexpand slot-name env))
- (let* ((slot-name (eval slot-name))
+ (let* ((slot-name (constant-form-value slot-name))
(bindings (unless (or (constantp new-value) (atom new-value))
(let ((object-var (gensym)))
(prog1 `((,object-var ,object))
(defmacro accessor-slot-boundp (object slot-name)
(aver (constantp slot-name))
- (let* ((slot-name (eval slot-name))
+ (let* ((slot-name (constant-form-value slot-name))
(boundp-name (slot-boundp-name slot-name)))
`(let ((.ignore. (load-time-value
(ensure-accessor 'boundp ',boundp-name ',slot-name))))
(define-compiler-macro slot-value (&whole form object slot-name)
(if (and (constantp slot-name)
- (interned-symbol-p (eval slot-name)))
+ (interned-symbol-p (constant-form-value slot-name)))
`(accessor-slot-value ,object ,slot-name)
form))
(define-compiler-macro set-slot-value (&whole form object slot-name new-value)
(if (and (constantp slot-name)
- (interned-symbol-p (eval slot-name)))
+ (interned-symbol-p (constant-form-value slot-name)))
`(accessor-set-slot-value ,object ,slot-name ,new-value)
form))
(define-compiler-macro slot-boundp (&whole form object slot-name)
(if (and (constantp slot-name)
- (interned-symbol-p (eval slot-name)))
+ (interned-symbol-p (constant-form-value slot-name)))
`(accessor-slot-boundp ,object ,slot-name)
form))
(when (and class-name (not (eq class-name t)))
(position parameter-or-nil slots :key #'car))))))
(if (constantp form)
- (let ((form (eval form)))
+ (let ((form (constant-form-value form)))
(if (symbolp form)
form
*unspecific-arg*))
;;; It is safe for these two functions to be wrong. They just try to
;;; guess what the most likely case will be.
(defun generate-fast-class-slot-access-p (class-form slot-name-form)
- (let ((class (and (constantp class-form) (eval class-form)))
- (slot-name (and (constantp slot-name-form) (eval slot-name-form))))
+ (let ((class (and (constantp class-form) (constant-form-value class-form)))
+ (slot-name (and (constantp slot-name-form)
+ (constant-form-value slot-name-form))))
(and (eq *boot-state* 'complete)
(standard-class-p class)
(not (eq class *the-class-t*)) ; shouldn't happen, though.
(and slotd (eq :class (slot-definition-allocation slotd)))))))
(defun skip-fast-slot-access-p (class-form slot-name-form type)
- (let ((class (and (constantp class-form) (eval class-form)))
- (slot-name (and (constantp slot-name-form) (eval slot-name-form))))
+ (let ((class (and (constantp class-form) (constant-form-value class-form)))
+ (slot-name (and (constantp slot-name-form)
+ (constant-form-value slot-name-form))))
(and (eq *boot-state* 'complete)
(standard-class-p class)
(not (eq class *the-class-t*)) ; shouldn't happen, though.
(declare (optimize (safety 3) (space 3) (compilation-speed 3)
(speed 0) (debug 1)))
(not (not (logbitp 0 (floor 2147483651 (min -23 0))))))))))
+
+
(assert (constantp (find-class 'symbol)))
(assert (constantp #p""))
+;;; More CONSTANTP tests
+;;; form constantp sb-int:constant-form-value
+(dolist (test '((t t t)
+ (x nil)
+ ('x t x)
+ (:keyword t :keyword)
+ (42 t 42)
+ ((if t :ok x) t :ok)
+ ((if t x :no) nil)
+ ((progn
+ (error "oops")
+ t) nil)
+ ((progn 1 2 3) t 3)
+ ((block foo :good) t :good)
+ ((block foo
+ (return-from foo t)) nil)
+ ((progv
+ (list (gensym))
+ '(1)
+ (+ 1)) nil)
+ ((progv
+ '(x)
+ (list (random 2))
+ x) nil)
+ ((progv
+ '(x)
+ '(1)
+ (1+ x)) t 2)
+ ((unwind-protect 1 nil) t 1)
+ ((unwind-protect 1
+ (xxx)) nil)
+ ((the integer 1) t 1)
+ ((the integer (+ 1 1)) t 2)
+ ((the integer (foo)) nil)
+ ((+ 1 2) t 3)))
+ (destructuring-bind (form c &optional v) test
+ (assert (eql (constantp form) c))
+ (when c
+ (assert (eql v (sb-int:constant-form-value form))))))
+
;;; DEFPARAMETER must assign a dynamic variable
(let ((var (gensym)))
(assert (equal (eval `(list (let ((,var 1))
;;; 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".)
-"0.9.10.3"
+"0.9.10.4"
projects / sbcl.git / commitdiff