mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-01 02:00:36 -08:00
Code Issues Projects Releases Packages Wiki Activity

Code for handling :IMPORT-FROM in DEFPACKAGE was bogus

Browse source
This commit is contained in:
jjgarcia 2002-05-22 13:38:33 +00:00
parent 7e5cacd38e
commit ded8f34629
1 changed files with 14 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

25
src/lsp/defpackage.lsp
View file

@ -106,25 +106,26 @@
:EXPORT-FROM) :test #'eq)
(cerror "Proceed, ignoring this option."
"~s is not a valid DEFPACKAGE option." option)))
(labels ((option-test (arg1 arg2)
(labels ((to-string (x) (if (numberp x) x (string x)))
(option-test (arg1 arg2)
(when (consp arg2) (equal (car arg2) arg1)))
(option-values-list (option options &aux output)
(dolist (o options)
(let ((o-option (first o)))
(when (string= o-option option)
(let* ((o-package (string (second o)))
(o-symbols (mapcar #'(lambda (x)
(if (numberp x) x (string x)))
(cddr o))))
(setf (cdr (assoc output o-package))
(union o-symbols (cdr (assoc output o-package))
:test #'equal))))))
(former-symbols (assoc o-package output))
(o-symbols (union (mapcar #'to-string (cddr o))
(cdr former-symbols)
:test #'equal)))
(if former-symbols
(setf (cdr former-symbols) o-symbols)
(setq output (acons o-package o-symbols output)))))))
output)
(option-values (option options &aux output)
(dolist (o options)
(let ((o-option (first o))
(o-symbols (mapcar #'(lambda (x) (if (numberp x) x (string x)))
(cdr o))))
(o-symbols (mapcar #'to-string (cdr o))))
(when (string= o-option option)
(setq output (union o-symbols output :test #'equal)))))
output))
@ -205,8 +206,10 @@
(first shadowing-imported-from-symbol-names-list)))
(use-package (or use "CL"))
(when imported-from-symbol-names-list
(import (rest imported-from-symbol-names-list)
(first imported-from-symbol-names-list)))
(dolist (item imported-from-symbol-names-list)
(let ((package (find-package (car item))))
(dolist (name (cdr item))
(import (find-symbol name package) *package*)))))
(when exported-symbol-names
(export (mapcar #'intern exported-symbol-names)))
(when exported-from-package-names