Changeset 11153


Ignore:
Timestamp:
02/22/07 17:51:00 (15 years ago)
Author:
piso
Message:

Reverted last change.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/defpackage.lisp

    r11152 r11153  
    22;;;
    33;;; Copyright (C) 2003-2007 Peter Graves
    4 ;;; $Id: defpackage.lisp,v 1.4 2007-02-22 17:14:31 piso Exp $
     4;;; $Id: defpackage.lisp,v 1.5 2007-02-22 17:51:00 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(in-package "SYSTEM")
    2121
    22 (in-package "SYSTEM")
     22;;; From CMUCL.
    2323
    2424(defun stringify-names (names)
    2525  (mapcar #'string names))
    26 
    27 (defun find-package-or-lose (designator)
    28   (or (find-package designator)
    29       (error "~S does not designate a package." designator)))
    3026
    3127;; FIXME Better error reporting!
     
    3834          (error 'program-error))))))
    3935
    40 (defmacro defpackage (defined-package-name &rest options)
     36(defmacro defpackage (package &rest options)
     37  "Defines a new package called PACKAGE.  Each of OPTIONS should be one of the
     38   following:
     39   (:NICKNAMES {package-name}*)
     40   (:SIZE <integer>)
     41   (:SHADOW {symbol-name}*)
     42   (:SHADOWING-IMPORT-FROM <package-name> {symbol-name}*)
     43   (:USE {package-name}*)
     44   (:IMPORT-FROM <package-name> {symbol-name}*)
     45   (:INTERN {symbol-name}*)
     46   (:EXPORT {symbol-name}*)
     47   (:DOCUMENTATION doc-string)
     48   All options except :SIZE and :DOCUMENTATION can be used multiple times."
    4149  (let ((nicknames nil)
    4250  (size nil)
     
    7886           (acons package-name names shadowing-imports))))))
    7987  (:use
    80    (let ((new (mapcar #'find-package-or-lose (cdr option))))
    81      (setq use (delete-duplicates (nconc use new) :test #'eq))
    82      (setq use-p t)))
     88   (let ((new (stringify-names (cdr option))))
     89     (setf use (delete-duplicates (nconc use new) :test #'string=))
     90     (setf use-p t)))
    8391  (:import-from
    8492   (let ((package-name (string (second option)))
     
    108116        `(:shadowing-import-from
    109117          ,@(apply #'append (mapcar #'rest shadowing-imports))))
    110     `(%defpackage ,(string defined-package-name) ',nicknames ',size
     118    `(%defpackage ,(string package) ',nicknames ',size
    111119                  ',shadows ',shadowing-imports ',(if use-p use nil)
    112120                  ',imports ',interns ',exports ',doc)))
Note: See TracChangeset for help on using the changeset viewer.