Commit ece9fa32 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Rename package-system to package-inferred-system.

parent 30562050

Makefile

+1 −1
Original line number Diff line number Diff line
@@ -54,7 +54,7 @@ XCL ?= xcl 


header_lisp := header.lisp

driver_lisp := uiop/package.lisp uiop/common-lisp.lisp uiop/utility.lisp uiop/os.lisp uiop/pathname.lisp uiop/filesystem.lisp uiop/stream.lisp uiop/image.lisp uiop/run-program.lisp uiop/lisp-build.lisp uiop/configuration.lisp uiop/backward-driver.lisp uiop/driver.lisp

defsystem_lisp := upgrade.lisp component.lisp system.lisp cache.lisp find-system.lisp find-component.lisp operation.lisp action.lisp lisp-action.lisp plan.lisp operate.lisp output-translations.lisp source-registry.lisp backward-internals.lisp parse-defsystem.lisp bundle.lisp concatenate-source.lisp backward-interface.lisp package-system.lisp interface.lisp user.lisp footer.lisp

defsystem_lisp := upgrade.lisp component.lisp system.lisp cache.lisp find-system.lisp find-component.lisp operation.lisp action.lisp lisp-action.lisp plan.lisp operate.lisp output-translations.lisp source-registry.lisp backward-internals.lisp parse-defsystem.lisp bundle.lisp concatenate-source.lisp backward-interface.lisp package-inferred-system.lisp interface.lisp user.lisp footer.lisp

all_lisp := $(header_lisp) $(driver_lisp) $(defsystem_lisp)



# Making ASDF itself should be our first, default, target:

asdf.asd

+5 −5
Original line number Diff line number Diff line
@@ -3,7 +3,7 @@ 
;;;                                                                  ;;;

;;; Free Software available under an MIT-style license.              ;;;

;;;                                                                  ;;;

;;; Copyright (c) 2001-2013 Daniel Barlow and contributors           ;;;

;;; Copyright (c) 2001-2014 Daniel Barlow and contributors           ;;;

;;;                                                                  ;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -61,11 +61,11 @@ 
   (:file "bundle" :depends-on ("lisp-action" "operate" "parse-defsystem"))

   (:file "concatenate-source" :depends-on ("plan" "parse-defsystem" "bundle"))

   (:file "backward-interface" :depends-on ("operate" "output-translations"))

   (:file "package-system" :depends-on ("system" "find-system" "parse-defsystem"))

   (:file "package-inferred-system" :depends-on ("system" "find-system" "parse-defsystem"))

   (:file "interface" :depends-on

          ("parse-defsystem" "concatenate-source"

           "backward-interface" "backward-internals"

           "output-translations" "source-registry" "package-system"))

           "output-translations" "source-registry" "package-inferred-system"))

   (:file "user" :depends-on ("interface"))

   (:file "footer" :depends-on ("user"))))
@@ -78,10 +78,10 @@ 
  :version "3.1.0.114" ;; to be automatically updated by make bump-version

  :depends-on ()

  #+asdf3 :encoding #+asdf3 :utf-8

  :class #.(if (find-class 'package-system nil) 'package-system 'system)

  :class #.(if (find-class 'package-inferred-system nil) 'package-inferred-system 'system)

  ;; For most purposes, asdf itself specially counts as a builtin system.

  ;; If you want to link it or do something forbidden to builtin systems,

  ;; specify separate dependencies on UIOP (aka asdf-driver) and asdf/defsystem.

  ;; specify separate dependencies on uiop (aka asdf-driver) and asdf/defsystem.

  #+asdf3 :builtin-system-p #+asdf3 t

  :components ((:module "build" :components ((:file "asdf"))))

  :in-order-to (#+asdf3 (prepare-op (monolithic-concatenate-source-op :asdf/defsystem))))

doc/asdf.texinfo

+10 −10
Original line number Diff line number Diff line
@@ -127,7 +127,7 @@ Defining systems with defsystem 
* A more involved example::

* The defsystem grammar::

* Other code in .asd files::

* The package-system extension::

* The package-inferred-system extension::



The object model of ASDF
@@ -938,7 +938,7 @@ software. 
* A more involved example::

* The defsystem grammar::

* Other code in .asd files::

* The package-system extension::

* The package-inferred-system extension::

@end menu



@node  The defsystem form, A more involved example, Defining systems with defsystem, Defining systems with defsystem
@@ -1537,7 +1537,7 @@ which in conjunction with if-component-dep-fails would offer 
a roundabout way to express conditional compilation.





@node Other code in .asd files, The package-system extension, The defsystem grammar, Defining systems with defsystem

@node Other code in .asd files, The package-inferred-system extension, The defsystem grammar, Defining systems with defsystem

@section Other code in .asd files



Files containing @code{defsystem} forms
@@ -1565,8 +1565,8 @@ of output from ASDF operations. 
@end itemize





@node The package-system extension,  , Other code in .asd files, Defining systems with defsystem

@section The package-system extension

@node The package-inferred-system extension,  , Other code in .asd files, Defining systems with defsystem

@section The package-inferred-system extension



Starting with ASDF 3.0.3,

ASDF supports a one-package-per-file style of programming,
@@ -1574,7 +1574,7 @@ whereby each file is its own system, 
and dependencies are deduced from the @code{defpackage} form.



In this style, packages referring to a same-named system (downcased);

and if a system is defined with @code{:class package-system},

and if a system is defined with @code{:class package-inferred-system},

then system names that start with that name

(using the slash @code{/} separator)

refer to files under the filesystem hierarchy where the system is defined.
@@ -1589,12 +1589,12 @@ It is used by ASDF itself (starting with ASDF 3) and by @code{lisp-interface-lib 


To use this style, choose a toplevel system name, e.g. @code{my-lib},

and create a file @file{my-lib.asd}

with the @code{:class :package-system} option in its @code{defsystem}.

with the @code{:class :package-inferred-system} option in its @code{defsystem}.

For instance:

@example

#-asdf (error "my-lib requires ASDF 3")

(defsystem my-lib

  :class :package-system

  :class :package-inferred-system

  :defsystem-depends-on (:asdf-package-system)

  :depends-on (:my-lib/src/all)

  :in-order-to ((test-op (load-op :my-lib/test/all)))
@@ -1605,9 +1605,9 @@ For instance: 


In the code above, the

@code{:defsystem-depends-on (:asdf-package-system)} is

for compatibility with older versions of ASDF 3 (ASDF 2 not supported),

for compatibility with older versions of ASDF 3 (ASDF 2 is not supported),

and requires the @code{asdf-package-system} library to be present

(it is implicitly provided by ASDF starting with ASDF 3.0.3).

(it is implicitly provided by ASDF starting with ASDF 3.1.1).



The function @code{register-system-packages} has to be called to register

packages used or provided by your system and its components

interface.lisp

+4 −3
Original line number Diff line number Diff line
@@ -12,7 +12,7 @@ 
   :asdf/operation :asdf/action :asdf/lisp-action

   :asdf/output-translations :asdf/source-registry

   :asdf/plan :asdf/operate :asdf/parse-defsystem :asdf/bundle :asdf/concatenate-source

   :asdf/backward-internals :asdf/backward-interface :asdf/package-system)

   :asdf/backward-internals :asdf/backward-interface :asdf/package-inferred-system)

  ;; Note: (1) we are NOT automatically reexporting everything from previous packages.

  ;; (2) we only reexport UIOP functionality when backward-compatibility requires it.

  (:export
@@ -59,7 +59,8 @@ 
   #:static-file #:doc-file #:html-file

   #:file-type #:source-file-type



   #:package-system #:register-system-packages

   #:package-inferred-system #:register-system-packages

   #:package-system ;; backward-compatibility during migration, to be removed in a further release.



   #:component-children          ; component accessors

   #:component-children-by-name
@@ -122,7 +123,7 @@ 
   #:missing-dependency-of-version

   #:circular-dependency        ; errors

   #:duplicate-names #:non-toplevel-system #:non-system-system

   #:package-system-missing-package-error

   #:package-inferred-system-missing-package-error

   #:operation-definition-warning #:operation-definition-error



   #:try-recompiling

package-system.lisp→package-inferred-system.lisp

+30 −22
Original line number Diff line number Diff line 
;;;; -------------------------------------------------------------------------

;;;; Package systems in the style of quick-build or faslpath



(uiop:define-package :asdf/package-system

  (:recycle :asdf/package-system :asdf)

(uiop:define-package :asdf/package-inferred-system

  (:recycle :asdf/package-inferred-system :asdf/package-system :asdf)

  (:use :uiop/common-lisp :uiop

        :asdf/defsystem ;; Using the old name of :asdf/parse-defsystem for compatibility

        :asdf/upgrade :asdf/component :asdf/system :asdf/find-system :asdf/lisp-action)

  (:export

   #:package-system #:register-system-packages #:sysdef-package-system-search

   #:*defpackage-forms* #:*package-systems* #:package-system-missing-package-error))

(in-package :asdf/package-system)

   #:package-inferred-system #:sysdef-package-inferred-system-search

   #:package-system ;; backward compatibility only. To be removed.

   #:register-system-packages 

   #:*defpackage-forms* #:*package-inferred-systems* #:package-inferred-system-missing-package-error))

(in-package :asdf/package-inferred-system)



(with-upgradability ()

  (defparameter *defpackage-forms* '(cl:defpackage uiop:define-package))



  (defun initial-package-systems-table ()

  (defun initial-package-inferred-systems-table ()

    (let ((h (make-hash-table :test 'equal)))

      (dolist (p (list-all-packages))

        (dolist (n (package-names p))

          (setf (gethash n h) t)))

      h))



  (defvar *package-systems* (initial-package-systems-table))

  (defvar *package-inferred-systems* (initial-package-inferred-systems-table))



  (defclass package-system (system)

  (defclass package-inferred-system (system)

    ())



  ;; For backward compatibility only. To be removed in an upcoming release:

  (defclass package-system (package-inferred-system) ())



  (defun defpackage-form-p (form)

    (and (consp form)

         (member (car form) *defpackage-forms*)))
@@ -39,12 +44,12 @@ 
    (with-input-file (f file)

      (stream-defpackage-form f)))



  (define-condition package-system-missing-package-error (system-definition-error)

  (define-condition package-inferred-system-missing-package-error (system-definition-error)

    ((system :initarg :system :reader error-system)

     (pathname :initarg :pathname :reader error-pathname))

    (:report (lambda (c s)

               (format s (compatfmt "~@<No package form found while ~

                                     trying to define package-system ~A from file ~A~>")

                                     trying to define package-inferred-system ~A from file ~A~>")

                       (error-system c) (error-pathname c)))))



  (defun package-dependencies (defpackage-form)
@@ -73,23 +78,23 @@ the DEFPACKAGE-FORM uses it or imports a symbol from it." 
    "Register SYSTEM as providing PACKAGES."

    (let ((name (or (eq system t) (coerce-name system))))

      (dolist (p (ensure-list packages))

        (setf (gethash (package-designator-name p) *package-systems*) name))))

        (setf (gethash (package-designator-name p) *package-inferred-systems*) name))))



  (defun package-name-system (package-name)

    "Return the name of the SYSTEM providing PACKAGE-NAME, if such exists,

otherwise return a default system name computed from PACKAGE-NAME."

    (check-type package-name string)

    (if-let ((system-name (gethash package-name *package-systems*)))

    (if-let ((system-name (gethash package-name *package-inferred-systems*)))

      system-name

      (string-downcase package-name)))



  (defun package-system-file-dependencies (file &optional system)

  (defun package-inferred-system-file-dependencies (file &optional system)

    (if-let (defpackage-form (file-defpackage-form file))

      (remove t (mapcar 'package-name-system (package-dependencies defpackage-form)))

      (error 'package-system-missing-package-error :system system :pathname file)))

      (error 'package-inferred-system-missing-package-error :system system :pathname file)))



  (defun same-package-system-p (system name directory subpath dependencies)

    (and (eq (type-of system) 'package-system)

  (defun same-package-inferred-system-p (system name directory subpath dependencies)

    (and (eq (type-of system) 'package-inferred-system)

         (equal (component-name system) name)

         (pathname-equal directory (component-pathname system))

         (equal dependencies (component-sideway-dependencies system))
@@ -101,26 +106,29 @@ otherwise return a default system name computed from PACKAGE-NAME." 
                       (and (slot-boundp child 'relative-pathname)

                            (equal (slot-value child 'relative-pathname) subpath))))))))



  (defun sysdef-package-system-search (system)

  (defun sysdef-package-inferred-system-search (system)

    (let ((primary (primary-system-name system)))

      (unless (equal primary system)

        (let ((top (find-system primary nil)))

          (when (typep top 'package-system)

          (when (typep top 'package-inferred-system)

            (if-let (dir (system-source-directory top))

              (let* ((sub (subseq system (1+ (length primary))))

                     (f (probe-file* (subpathname dir sub :type "lisp")

                                     :truename *resolve-symlinks*)))

                (when (file-pathname-p f)

                  (let ((dependencies (package-system-file-dependencies f system))

                  (let ((dependencies (package-inferred-system-file-dependencies f system))

                        (previous (cdr (system-registered-p system))))

                    (if (same-package-system-p previous system dir sub dependencies)

                    (if (same-package-inferred-system-p previous system dir sub dependencies)

                        previous

                        (eval `(defsystem ,system

                                 :class package-system

                                 :class package-inferred-system

                                 :source-file nil

                                 :pathname ,dir

                                 :depends-on ,dependencies

                                 :components ((cl-source-file "lisp" :pathname ,sub)))))))))))))))



(with-upgradability ()

  (pushnew 'sysdef-package-system-search *system-definition-search-functions*))
 
  (pushnew 'sysdef-package-inferred-system-search *system-definition-search-functions*)

  (setf *system-definition-search-functions*

        (remove (find-symbol* :sysdef-package-system-search :asdf/package-system nil)

                *system-definition-search-functions*)))