Changeset 12661


Ignore:
Timestamp:
Aug 24, 2009, 4:12:38 PM (10 years ago)
Author:
gz
Message:

arg-names-from-map: return nil if lfun is nil

File:
1 edited

Legend:

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

    r11133 r12661  
    197197
    198198(defun arg-names-from-map (lfun pc)
    199   (multiple-value-bind (nreq nopt restp nkeys allow-other-keys
    200                              optinit lexprp
    201                              ncells nclosed)
    202       (function-args lfun)
    203     (declare (ignore optinit ncells allow-other-keys))
    204     (collect ((req)
    205               (opt)
    206               (keys))
    207       (let* ((rest nil)
    208              (map (if (and pc (> pc target::arg-check-trap-pc-limit))
    209                     (car (function-symbol-map lfun)))))
    210         (if (and map pc)
    211           (let ((total (+ nreq nopt (if (or restp lexprp) 1 0) (or nkeys 0)))
    212                 (idx (- (length map) nclosed)))
    213             (unless (zerop total)
    214               (progn
    215                 (dotimes (x (the fixnum nreq))
    216                   (declare (fixnum x))
    217                   (req (if (> idx 0) (elt map (decf idx)) (make-arg "ARG" x))))
    218                 (when (neq nopt 0)
    219                   (dotimes (x (the fixnum nopt))
    220                     (opt (if (> idx 0) (elt map (decf idx)) (make-arg "OPT" x)))))
    221                 (when (or restp lexprp)
    222                   (setq rest (if (> idx 0) (elt map (decf idx)) 'the-rest)))
    223                 (when nkeys
    224                   (dotimes (i (the fixnum nkeys))
    225                     (keys (if (> idx 0) (elt map (decf idx)) (make-arg "KEY" i)))))))))
    226         (values (or (not (null map))
    227                     (and (eql 0 nreq) (eql 0 nopt) (not restp) (null nkeys)))
    228                 (req) (opt) rest (keys))))))
     199  (when lfun
     200    (multiple-value-bind (nreq nopt restp nkeys allow-other-keys
     201                               optinit lexprp
     202                               ncells nclosed)
     203        (function-args lfun)
     204      (declare (ignore optinit ncells allow-other-keys))
     205      (collect ((req)
     206                (opt)
     207                (keys))
     208        (let* ((rest nil)
     209               (map (if (and pc (> pc target::arg-check-trap-pc-limit))
     210                        (car (function-symbol-map lfun)))))
     211          (if (and map pc)
     212              (let ((total (+ nreq nopt (if (or restp lexprp) 1 0) (or nkeys 0)))
     213                    (idx (- (length map) nclosed)))
     214                (unless (zerop total)
     215                  (progn
     216                    (dotimes (x (the fixnum nreq))
     217                      (declare (fixnum x))
     218                      (req (if (> idx 0) (elt map (decf idx)) (make-arg "ARG" x))))
     219                    (when (neq nopt 0)
     220                      (dotimes (x (the fixnum nopt))
     221                        (opt (if (> idx 0) (elt map (decf idx)) (make-arg "OPT" x)))))
     222                    (when (or restp lexprp)
     223                      (setq rest (if (> idx 0) (elt map (decf idx)) 'the-rest)))
     224                    (when nkeys
     225                      (dotimes (i (the fixnum nkeys))
     226                        (keys (if (> idx 0) (elt map (decf idx)) (make-arg "KEY" i)))))))))
     227          (values (or (not (null map))
     228                      (and (eql 0 nreq) (eql 0 nopt) (not restp) (null nkeys)))
     229                  (req) (opt) rest (keys)))))))
    229230             
    230231             
Note: See TracChangeset for help on using the changeset viewer.