Changeset 9118


Ignore:
Timestamp:
05/09/05 23:06:36 (16 years ago)
Author:
piso
Message:

DO-ALL-SYMBOLS.11

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/do-all-symbols.lisp

    r4147 r9118  
    11;;; do-all-symbols.lisp
    22;;;
    3 ;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: do-all-symbols.lisp,v 1.1 2003-09-30 11:11:36 piso Exp $
     3;;; Copyright (C) 2003-2005 Peter Graves
     4;;; $Id: do-all-symbols.lisp,v 1.2 2005-05-09 23:06:36 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    1818;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    1919
    20 ;;; Adapted from CMUCL.
     20;;; Adapted from SBCL.
    2121
    22 (in-package "SYSTEM")
     22(in-package #:system)
    2323
    2424(defmacro do-all-symbols ((var &optional result-form) &body body)
    25   (let ((flet-name (gensym "DO-SYMBOLS-")))
    26     `(block nil
    27        (flet ((,flet-name (,var)
    28                           (tagbody ,@body)))
    29          (dolist (package (list-all-packages))
    30            (flet ((iterate-over-symbols (symbols)
    31                                         (dolist (symbol symbols)
    32                                           (,flet-name symbol))))
    33              (iterate-over-symbols (package-internal-symbols package))
    34              (iterate-over-symbols (package-external-symbols package)))))
    35        (let ((,var nil))
    36          ,result-form))))
     25  (multiple-value-bind (forms decls) (parse-body body nil)
     26    (let ((flet-name (gensym "DO-SYMBOLS-")))
     27      `(block nil
     28         (flet ((,flet-name (,var)
     29                 ,@decls
     30                 (tagbody ,@forms)))
     31           (dolist (package (list-all-packages))
     32             (flet ((iterate-over-symbols (symbols)
     33                      (dolist (symbol symbols)
     34                        (,flet-name symbol))))
     35               (iterate-over-symbols (package-internal-symbols package))
     36               (iterate-over-symbols (package-external-symbols package)))))
     37         (let ((,var nil))
     38           (declare (ignorable ,var))
     39           ,@decls
     40           ,result-form)))))
Note: See TracChangeset for help on using the changeset viewer.