1 |
|
;;; Thu Aug 12 14:22:09 1993 by Mark Kantrowitz <mkant@cs.cmu.edu> |
2 |
|
;;; make-defpackage.lisp -- 1961 bytes |
3 |
|
|
4 |
|
;;; **************************************************************** |
5 |
|
;;; Make a Defpackage Form From Package State ********************** |
6 |
|
;;; **************************************************************** |
7 |
|
|
8 |
|
(defun make-defpackage-form (package-name) |
9 |
|
"Given a package, returns a defpackage form that could recreate the |
10 |
|
current state of the package, more or less." |
11 |
|
(let ((package (find-package package-name))) |
12 |
|
(let* ((name (package-name package)) |
13 |
|
(nicknames (package-nicknames package)) |
14 |
|
(package-use-list (package-use-list package)) |
15 |
|
(use-list (mapcar #'package-name package-use-list)) |
16 |
|
(externs nil) |
17 |
|
(shadowed-symbols (package-shadowing-symbols package)) |
18 |
|
(imports nil) |
19 |
|
(shadow-imports nil) |
20 |
|
(pure-shadow nil) |
21 |
|
(pure-import nil)) |
22 |
|
(do-external-symbols (sym package) (push (symbol-name sym) externs)) |
23 |
|
(do-symbols (sym package) |
24 |
|
(unless (or (eq package (symbol-package sym)) |
25 |
|
(find (symbol-package sym) package-use-list)) |
26 |
|
(push sym imports))) |
27 |
|
(setq shadow-imports (intersection shadowed-symbols imports)) |
28 |
|
(setq pure-shadow (set-difference shadowed-symbols shadow-imports)) |
29 |
|
(setq pure-import (set-difference imports shadow-imports)) |
30 |
|
`(defpackage ,name |
31 |
|
,@(when nicknames `((:nicknames ,@nicknames))) |
32 |
|
,@(when use-list `((:use ,@use-list))) |
33 |
|
,@(when externs `((:export ,@externs))) |
34 |
|
;; skip :intern |
35 |
|
,@(when pure-shadow |
36 |
|
`((:shadow ,@(mapcar #'symbol-name pure-shadow)))) |
37 |
|
,@(when shadow-imports |
38 |
|
(mapcar #'(lambda (symbol) |
39 |
|
`((:shadowing-import-from |
40 |
|
,(package-name (symbol-package symbol)) |
41 |
|
,(symbol-name symbol)))) |
42 |
|
shadow-imports)) |
43 |
|
,@(when pure-import |
44 |
|
(mapcar #'(lambda (symbol) |
45 |
|
`((:import-from |
46 |
|
,(package-name (symbol-package symbol)) |
47 |
|
,(symbol-name symbol)))) |
48 |
|
pure-import)))))) |
49 |
|
|
50 |
|
;;; *EOF* |