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

defpackage: factor checking into single function

Browse source 
Function is taken from SBCL.
This commit is contained in:
Daniel Kochmanski 2017-05-01 15:47:42 +02:00
parent 25ca08e5fc
commit f41b6e31d6
1 changed files with 20 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

47
src/lsp/defpackage.lsp
View file

@ -152,33 +152,14 @@
(otherwise
(cerror "Proceed, ignoring this option."
"~s is not a valid DEFPACKAGE option." option))))
(dolist (duplicate (find-duplicates shadowed-symbol-names
interned-symbol-names
(loop for list
in shadowing-imported-from-symbol-names-list
append (rest list))
(loop for list
in imported-from-symbol-names-list
append (rest list))))
(si:simple-program-error
"The symbol ~s cannot coexist in these lists:~{ ~s~}"
(first duplicate)
(loop for num in (rest duplicate)
collect (case num
(1 ':SHADOW)
(2 ':INTERN)
(3 ':SHADOWING-IMPORT-FROM)
(4 ':IMPORT-FROM)))))
(dolist (duplicate (find-duplicates exported-symbol-names
interned-symbol-names))
(si:simple-program-error
"The symbol ~s cannot coexist in these lists:~{ ~s~}"
(first duplicate)
(loop for num in (rest duplicate) collect
(case num
(1 ':EXPORT)
(2 ':INTERN)))))
(check-disjoint `(:intern ,@interned-symbol-names)
`(:export ,@exported-symbol-names))
(check-disjoint `(:intern ,@interned-symbol-names)
`(:import-from
,@(apply #'append (mapcar #'rest imported-from-symbol-names-list)))
`(:shadow ,@shadowed-symbol-names)
`(:shadowing-import-from
,@(apply #'append (mapcar #'rest shadowing-imported-from-symbol-names-list))))
`(eval-when (eval compile load)
(si::dodefpackage
,(string name)
@ -194,6 +175,18 @@
',imported-from-symbol-names-list
',exported-from-package-names)))))
(defun check-disjoint (&rest args)
;; An arg is (:key . set)
(do ((list args (cdr list)))
((endp list))
(loop
with x = (car list)
for y in (rest list)
for z = (remove-duplicates (intersection (cdr x)(cdr y) :test #'string=))
when z do (error 'simple-program-error
:format-control "Parameters ~S and ~S must be disjoint ~
but have common elements ~% ~S"
:format-arguments (list (car x)(car y) z)))))
(defun dodefpackage
(name