/[cmucl]/src/code/macros.lisp
ViewVC logotype

Diff of /src/code/macros.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.108 by rtoy, Fri Nov 18 19:36:17 2005 UTC revision 1.109 by rtoy, Thu Apr 13 13:48:58 2006 UTC
# Line 1623  Line 1623 
1623    
1624  ;;;; Iteration macros:  ;;;; Iteration macros:
1625    
1626    ;; Helper for dotimes.  Extract any declarations for the dotimes
1627    ;; counter and create a similar declaration for our dummy loop
1628    ;; counter.  Skip over special declarations, though, because we don't
1629    ;; want to make the dummy counter special.
1630    ;;
1631    ;; Returns two values:
1632    ;; 1.  Set of declarations for the dotimes loop counter that would be
1633    ;;     suitable for use in the result-form of the loop,
1634    ;; 2.  Declarations suitable for the dummy loop counter.
1635    (defun dotimes-extract-var-decls (var counter count decls)
1636      (let (var-decls counter-decls)
1637        (dolist (decl decls)
1638          (dolist (d (cdr decl))
1639            (when (member var (cdr d))
1640              (cond ((eq (car d) 'type)
1641                     (push `(type ,(second d) ,var) var-decls)
1642                     (push `(type ,(second d) ,counter) counter-decls))
1643                    ((eq (car d) 'special)
1644                     ;; Declare var special, but not the counter
1645                     (push `(,(car d) ,var) var-decls))
1646                    (t
1647                     (push `(,(car d) ,var) var-decls)
1648                     (push `(,(car d) ,counter) counter-decls))))))
1649        (unless counter-decls
1650          (setf counter-decls (if (numberp count)
1651                                  `((type (integer 0 ,count) ,counter))
1652                                  `((type unsigned-byte ,counter)))))
1653        (values (if var-decls
1654                    `((declare ,@(nreverse var-decls)))
1655                    nil)
1656                `((declare ,@(nreverse counter-decls))))))
1657    
1658    
1659  ;;; Make sure we iterate the given number of times, independent of  ;;; Make sure we iterate the given number of times, independent of
1660  ;;; what the body might do to the index variable.  We do this by  ;;; what the body might do to the index variable.  We do this by
1661  ;;; repeatedly binding the var in the body and also in the result  ;;; repeatedly binding the var in the body and also in the result
# Line 1633  Line 1666 
1666    (let ((count-var (gensym "CTR-")))    (let ((count-var (gensym "CTR-")))
1667      (multiple-value-bind (forms decls)      (multiple-value-bind (forms decls)
1668          (parse-body body nil nil)          (parse-body body nil nil)
1669        (cond ((numberp count)        (multiple-value-bind (var-decls ctr-decls)
1670               `(do ((,count-var 0 (1+ ,count-var)))            (dotimes-extract-var-decls var count-var count decls)
1671                    ((>= ,count-var ,count)          (cond ((numberp count)
1672                     (let ((,var ,count-var))                 `(do ((,count-var 0 (1+ ,count-var)))
1673                       ,var                      ((>= ,count-var ,count)
1674                       ,result))                       (let ((,var ,count-var))
1675                  (declare (type (integer 0 ,count) ,count-var))                         ,@var-decls
1676                  (let ((,var ,count-var))                         ,var
1677                    ,@decls                         ,result))
1678                    ,var                    ,@ctr-decls
1679                    (tagbody                    (let ((,var ,count-var))
1680                       ,@forms))))                      ,@decls
1681              (t (let ((v1 (gensym)))                      ,var
1682                   `(do ((,count-var 0 (1+ ,count-var))                      (tagbody
1683                         (,v1 ,count))                         ,@forms))))
1684                        ((>= ,count-var ,v1)                (t (let ((v1 (gensym)))
1685                         (let ((,var ,count-var))                     `(do ((,count-var 0 (1+ ,count-var))
1686                           ,var                           (,v1 ,count))
1687                           ,result))                          ((>= ,count-var ,v1)
1688                      (declare (type unsigned-byte ,count-var))                           (let ((,var ,count-var))
1689                      (let ((,var ,count-var))                             ,@var-decls
1690                        ,@decls                             ,var
1691                        ,var                             ,result))
1692                        (tagbody                        ,@ctr-decls
1693                           ,@forms)))))))))                        (let ((,var ,count-var))
1694                            ,@decls
1695                            ,var
1696                            (tagbody
1697                               ,@forms))))))))))
1698    
1699    
1700  ;;; We repeatedly bind the var instead of setting it so that we never give the  ;;; We repeatedly bind the var instead of setting it so that we never give the

Legend:
Removed from v.1.108  
changed lines
  Added in v.1.109

  ViewVC Help
Powered by ViewVC 1.1.5