Changeset 10722


Ignore:
Timestamp:
Sep 12, 2008, 2:13:55 PM (11 years ago)
Author:
gz
Message:

make incf/decf propagate explicit type info, so that (incf (the fixnum (svref x y))) knows to do a fixnum addition without overflow checking

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lib/setf.lisp

    r9924 r10722  
    316316    (multiple-value-bind (dummies vals newval setter getter)
    317317        (get-setf-method place env)
    318       (let ((d (gensym)))
     318      (let ((d (gensym))
     319            ;; Doesn't propagate inferred types, but better than nothing.
     320            (d-type (cond ((constantp delta) (type-of delta))
     321                          ((and (consp delta) (eq (car delta) 'the)) (cadr delta))
     322                          (t t)))
     323            (v-type (if (and (consp place) (eq (car place) 'the)) (cadr place) t)))
    319324        `(let* (,@(mapcar #'list dummies vals)
    320325                (,d ,delta)
    321326                (,(car newval) (+ ,getter ,d)))
    322           ,setter)))))
     327           (declare (type ,d-type ,d) (type ,v-type ,(car newval)))
     328           ,setter)))))
    323329
    324330(defmacro decf (place &optional (delta 1) &environment env)
     
    332338    (multiple-value-bind (dummies vals newval setter getter)
    333339        (get-setf-method place env)
    334       (let ((d (gensym)))
     340      (let* ((d (gensym))
     341             ;; Doesn't propagate inferred types, but better than nothing.
     342             (d-type (cond ((constantp delta) (type-of delta))
     343                           ((and (consp delta) (eq (car delta) 'the)) (cadr delta))
     344                           (t t)))
     345             (v-type (if (and (consp place) (eq (car place) 'the)) (cadr place) t)))
    335346        `(let* (,@(mapcar #'list dummies vals)
    336347                (,d ,delta)
    337348                (,(car newval) (- ,getter ,d)))
    338           ,setter)))))
     349           (declare (type ,d-type ,d) (type ,v-type ,(car newval)))
     350           ,setter)))))
    339351 
    340352(defmacro psetf (&whole call &rest pairs &environment env)  ;same structure as psetq
Note: See TracChangeset for help on using the changeset viewer.