Pascal Bourguignon <[EMAIL PROTECTED]> writes:
> We'd still have to resolve the version problem first.
Easy. (Feel free to utilize, mangle, and ignore -- as suits
the project.)
;;;; Sketch for versioned packages, "basically works", but most
;;;; certainly not well tested. Ironically, notice the lack of
;;;; both documentation and specification...
;;;;
;;;; Placed in Public Domain by the author.
(defvar *package-versions* (make-hash-table :test #'equal))
(defvar *versioned-packages* (make-hash-table))
(defun package-version (package)
(cdr (gethash (find-package package) *versioned-packages*)))
(defun package-basename (package)
(car (gethash (find-package package) *versioned-packages*)))
(defun find-package-version (package version)
(car (rassoc version (gethash (package-basename package)
*package-versions*))))
(defun list-package-versions (package)
(sort (mapcar #'cdr (gethash (package-basename package) *package-versions*))
#'<))
(defun steal-package-nickname (package nickname)
(let ((old (find-package nickname)))
(when old
(when (equal nickname (package-name old))
(error "Cannot steal the primary name of a package: ~A" old))
(rename-package old (package-name old)
(remove nickname (package-nicknames old) :test #'equal))))
(rename-package package (package-name package)
(cons nickname (package-nicknames package))))
(defmacro defpackage* (name &body options)
(let* ((version (second (assoc :version options)))
(rest (remove :version options :key #'car))
(sname (string name))
(vname (format nil "~A.~D" name version)))
(check-type version (or null real))
`(progn
(defpackage ,vname ,@rest)
,@
(when version
(when (< 1 (count :version options :key #'car))
(error "Multiple :VERSION options in DEFPACKAGE* ~A" name))
`((let ((this (find-package ,vname))
(old (find-package ,sname)))
(setf (gethash this *versioned-packages*) (cons ,sname ,version))
(pushnew (cons this ,version) (gethash ,sname *package-versions*)
:key #'cdr)
(when (or (not old) (< (package-version old) ,version))
(steal-package-nickname this ,sname))))))))
(defpackage* foo (:version 1))
(defpackage* foo (:version 2))
(package-version (find-package "FOO")) ; => 2
(list-package-versions (find-package "FOO.1")) ; => (1 2)
(package-basename (find-package "FOO.1")) ; => "FOO"
(find-package-version (find-package "FOO") 1) ; => #<PACKAGE "FOO.1">
Cheers,
-- Nikodemus Schemer: "Buddha is small, clean, and serious."
Lispnik: "Buddha is big, has hairy armpits, and laughs."
_______________________________________________
Gardeners mailing list
[email protected]
http://www.lispniks.com/mailman/listinfo/gardeners
