Changeset 7254


Ignore:
Timestamp:
Sep 19, 2007, 7:44:13 AM (12 years ago)
Author:
gb
Message:

ARGLIST-FROM-MAP: don't be afraid to say &LEXPR.
ARG-NAMES-FROM-MAP: &rest in map before &keys now.

File:
1 edited

Legend:

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

    r7019 r7254  
    166166    (declare (ignore optinit))
    167167    (if lexprp
    168       (values nil nil)
    169       (let ((map (car (function-symbol-map lfun))))
    170         (if map
    171           (let ((total (+ nreq nopt (if restp 1 0) (or nkeys 0)))
    172                 (idx (- (length map) nclosed))
    173                 (res nil))
    174             (if (%izerop total)
    175               (values nil t)
    176               (progn
    177                 (dotimes (x nreq)
    178                   (declare (fixnum x))
    179                   (push (if (> idx 0) (elt map (decf idx)) (make-arg "ARG" x)) res))
    180                 (when (neq nopt 0)
    181                   (push '&optional res)
    182                   (dotimes (x (the fixnum nopt))
    183                     (push (if (> idx 0) (elt map (decf idx)) (make-arg "OPT" x)) res)))
    184 
    185                 (when restp
    186                   (push '&rest res)
    187                   (when nkeys
    188                     (when (> idx nkeys) (decf idx nkeys)))
    189                   (push (if (> idx 0) (elt map (decf idx)) 'the-rest) res))                  (when nkeys
    190                   (push '&key res)
    191                   (let ((keyvect (lfun-keyvect lfun)))
    192                     (dotimes (i (length keyvect))
    193                       (push (elt keyvect i) res))))
    194                 (when allow-other-keys
    195                   (push '&allow-other-keys res))))
    196             (values (nreverse res) t))
    197           (values nil (zerop ncells)))))))
     168      (setq restp t))
     169    (let ((map (car (function-symbol-map lfun))))
     170      (if map
     171        (let ((total (+ nreq nopt (if restp 1 0) (or nkeys 0)))
     172              (idx (- (length map) nclosed))
     173              (res nil))
     174          (if (%izerop total)
     175            (values nil t)
     176            (progn
     177              (dotimes (x nreq)
     178                (declare (fixnum x))
     179                (push (if (> idx 0) (elt map (decf idx)) (make-arg "ARG" x)) res))
     180              (when (neq nopt 0)
     181                (push '&optional res)
     182                (dotimes (x (the fixnum nopt))
     183                  (push (if (> idx 0) (elt map (decf idx)) (make-arg "OPT" x)) res)))
     184
     185              (when restp
     186                (push (if lexprp '&lexpr '&rest) res)
     187                (when nkeys
     188                  (when (> idx nkeys) (decf idx nkeys)))
     189                (push (if (> idx 0) (elt map (decf idx)) 'the-rest) res))                  (when nkeys
     190                (push '&key res)
     191                (let ((keyvect (lfun-keyvect lfun)))
     192                  (dotimes (i (length keyvect))
     193                    (push (elt keyvect i) res))))
     194              (when allow-other-keys
     195                (push '&allow-other-keys res))))
     196          (values (nreverse res) t))
     197        (values nil (zerop ncells))))))
    198198
    199199(defun arg-names-from-map (lfun pc)
     
    219219                  (dotimes (x (the fixnum nopt))
    220220                    (opt (if (> idx 0) (elt map (decf idx)) (make-arg "OPT" x)))))
    221                 (when nkeys
    222                   (dotimes (i (the fixnum nkeys))
    223                     (keys (if (> idx 0) (elt map (decf idx)) (make-arg "KEY" i)))))
    224221                (when (or restp lexprp)
    225                   (setq rest (if (> idx 0) (elt map (decf idx)) 'the-rest)))))))
     222                  (setq rest (if (> idx 0) (elt map (decf idx)) 'the-rest)))                (when nkeys
     223                                                                                              (dotimes (i (the fixnum nkeys))
     224                    (keys (if (> idx 0) (elt map (decf idx)) (make-arg "KEY" i)))))))))
    226225        (values (not (null map)) (req) (opt) rest (keys))))))
    227226             
Note: See TracChangeset for help on using the changeset viewer.