(declaim (optimize (speed 3) (safety 1)))

(defstruct slot-ic
  (key nil :type (or wm-map null))
  (sel nil :type (or symbol null))
  (value 0 :type fixnum))

#-ecl
(defmethod make-load-form ((s slot-ic) &optional env)
  '(make-slot-ic))

(defun sic-miss (cache selector argument)
  (when (wm-object-p argument)
    (let* ((map (wm-object-map argument))
           (slot (gethash selector (wm-map-slots map))))
      (when slot
        (let ((offset (wm-slot-index slot)))
          (when (>= offset 0)
            (setf (slot-ic-key cache) map)
            (setf (slot-ic-sel cache) selector)
            (setf (slot-ic-value cache) offset)
            (svref (wm-object-slots argument) offset)))))))

(defmacro sic-get-slot (selector argument (fail-arg fail))
  (let ((arg-sym (%gensym))
#-ecl
        (cache (make-slot-ic))
#+ecl
        (cache `(%load-form ,(%gensym) (make-slot-ic)))
       )
   `(let ((,arg-sym ,argument))
      (if (and (wm-object-p ,arg-sym) 
               (eq (wm-object-map ,arg-sym) (slot-ic-key ,cache))
               (eq ,selector (slot-ic-sel ,cache)))
          (svref (wm-object-slots ,arg-sym) (slot-ic-value ,cache))
          (or (sic-miss ,cache ,selector ,arg-sym) (let ((,fail-arg ,arg-sym)) ,fail))))))

(defun sic-set-miss (cache selector argument value)
  (when (wm-object-p argument)
    (let* ((map (wm-object-map argument))
           (slot (gethash selector (wm-map-slots map))))
      (when slot
        (let ((offset (wm-slot-index slot)))
          (when (and (>= offset 0) (not (wm-slot-delegates slot)))
            (setf (slot-ic-key cache) map)
            (setf (slot-ic-sel cache) selector)
            (setf (slot-ic-value cache) offset)
            (setf (svref (wm-object-slots argument) offset) value)))))))

(defmacro sic-set-slot (selector argument value (fail-arg fail))
  (let ((arg-sym (%gensym))
#-ecl
        (cache (make-slot-ic))
#+ecl
        (cache `(%load-form ,(%gensym) (make-slot-ic)))
       )
   `(let ((,arg-sym ,argument))
      (if (and (wm-object-p ,arg-sym)
               (eq (wm-object-map ,arg-sym) (slot-ic-key ,cache))
               (eq ,selector (slot-ic-sel ,cache)))
          (setf (svref (wm-object-slots ,arg-sym) (slot-ic-value ,cache)) ,value)
          (or (sic-set-miss ,cache ,selector ,arg-sym ,value) (let ((,fail-arg ,arg-sym)) ,fail))))))