(defmacro-mundanely dotimes ((var count &optional (result nil)) &body body)
(cond ((numberp count)
`(do ((,var 0 (1+ ,var)))
- ((>= ,var ,count) ,result)
- (declare (type unsigned-byte ,var))
- ,@body))
+ ((>= ,var ,count) ,result)
+ (declare (type unsigned-byte ,var))
+ ,@body))
(t (let ((v1 (gensym)))
`(do ((,var 0 (1+ ,var)) (,v1 ,count))
- ((>= ,var ,v1) ,result)
- (declare (type unsigned-byte ,var))
- ,@body)))))
+ ((>= ,var ,v1) ,result)
+ (declare (type unsigned-byte ,var))
+ ,@body)))))
(defmacro-mundanely dolist ((var list &optional (result nil)) &body body)
;; We repeatedly bind the var instead of setting it so that we never
;; since we don't want to use IGNORABLE on what might be a special
;; var.
(multiple-value-bind (forms decls) (parse-body body :doc-string-allowed nil)
- (let ((n-list (gensym)))
- `(do* ((,n-list ,list (cdr ,n-list)))
- ((endp ,n-list)
- ,@(if result
- `((let ((,var nil))
- ,var
- ,result))
- '(nil)))
- (let ((,var (car ,n-list)))
- ,@decls
- (tagbody
- ,@forms))))))
+ (let ((n-list (gensym "N-LIST"))
+ (start (gensym "START")))
+ `(block nil
+ (let ((,n-list ,list))
+ (tagbody
+ ,start
+ (unless (endp ,n-list)
+ (let ((,var (car ,n-list)))
+ ,@decls
+ (setq ,n-list (cdr ,n-list))
+ (tagbody ,@forms))
+ (go ,start))))
+ ,(if result
+ `(let ((,var nil))
+ ,var
+ ,result)
+ nil)))))
\f
;;;; conditions, handlers, restarts
,n-cond
(car *restart-clusters*)
,(if (eq name 'cerror)
- `(cerror ,(second expression) ,n-cond)
+ `(cerror ,(second exp) ,n-cond)
`(,name ,n-cond))))
expression))
expression)))
`(let ((,(caaddr annotated-case)
,var))
,@body))
- ((not (cdr body))
- (car body))
(t
- `(progn ,@body)))))))
+ `(locally ,@body)))))))
annotated-cases))))))))
\f
;;;; miscellaneous