diff --git a/README.source-registry b/README.source-registry new file mode 100644 index 0000000000000000000000000000000000000000..770e2fd3e2d38ac81ef73fba788fe7be33b84b6c --- /dev/null +++ b/README.source-registry @@ -0,0 +1,210 @@ +General Idea +============ + +The general idea is that in configuration files such as + /etc/common-lisp/source-registry.conf + ~/.config/common-lisp/source-registry.conf +will be a SEXP in a trival domain-specific language +to specify a search path. + +Backwards Compatibility +======================= + +Now comes the issue of backwards compatibility with the current +asdf:*central-registry* that currently has to be manually configured +by users or supplemental layer (e.g. common-lisp-controller). + +My proposal is that there would be a new (private) variable + common-lisp-configuration::*source-registry* +that would store a parsed version of the configuration +as an undocumented opaque data-structure +(except for the private use of ASDF and XCVB), +only accessible through API functions and said DSL. +One magic directive in that DSL, present by default in the configuration, + :default-registry +would hook into the implementation defaults, which would include +the searching of asdf:*central-registry* until it is eventually removed. +Uses of asdf:*central-registry* would be deprecated, +but still supported for many years to come for backwards compatibility. + +The same DSL could be recognized by ASDF, XCVB, and any other future +build system for Common Lisp. + +Alternatives I considered and rejected included: + +1- Keep asdf:*central-registry* as the master with its current semantics, + and somehow the configuration parser expands the new configuration + language into a expanded series of directories of subdirectories to + lookup, pre-recursing through specified hierarchies. This is kludgy, + and leaves little space of future cleanups and extensions. + +2- Keep asdf:*central-registry* remains the master but extend its semantics + in completely new ways, so that new kinds of entries may be implemented + as a recursive search, etc. This seems somewhat backwards. + +3- Completely remove asdf:*central-registry* and break backwards compatibility. + Hopefully this will happen in a few years after everyone migrate to + a better ASDF and/or to XCVB, but it would be very bad to do it now. + +4- Replace asdf:*central-registry* by a symbol-macro with appropriate magic + when you dereference it or setf it. Only the new variable with new + semantics is handled by the new search procedure. + + +Configuration DSL +================= + +Here is the grammar of the SEXP DSL I am considering for configuration: + +;; A configuration is single SEXP starting with keyword :source-registry +;; followed by a list of directives. +CONFIGURATION := (:source-registry DIRECTIVE ...) + +;; A directive is one of the following: +DIRECTIVE := + ;; add a single directory to be scanned (no recursion) + (:directory DIRECTORY-PATHNAME-DESIGNATOR) | + + ;; add a directory hierarchy, recursing but excluding specified patterns + (:tree DIRECTORY-PATHNAME-DESIGNATOR &key exclude) | + + ;; override the default defaults for exclusion patterns + (:exclude-subdirectories PATTERN ...) | + + ;; splice the parsed contents of another config file + (:include-configuration REGULAR-FILE-PATHNAME-DESIGNATOR) | + + ;; Your configuration expression MUST have contain exactly one of these: + (:inherit-configuration) | ; splices contents of inherited configuration + (:ignore-inherited-configuration) ; drop contents of inherited configuration + + ;; This directive specifies that some default must be spliced. + (:default-registry) + +PATTERN := a string without wildcards, that will be matched exactly + against the name of a subdirectory. + + +Configuration Files +=================== + +Following a suggestion by Stelian, the configuration should be read in +this order, each configuration containing an expression that may extend +or override the previous configuration: + file /etc/common-lisp/source-registry.conf + file ~/.config/common-lisp/source-registry.conf + environment variable CL_SOURCE_REGISTRY + some implementation- or application- specific command-line argument. + +Equivalently (since the DSL doesn't allow for uncontrolled side-effects), +the outermost configuration only would be parsed, +and recursing to previous configurations would only happen +if and when specified. + +This also leaves the question of whether environment variable and +command-line arguments should take the same SEXP syntax (to be READ), +or whether they should have some more shell-friendly textual +representation of the same information. Allowing for a different +representation is probably more work for marginally more feature, +and I don't recommend it. So, in the end, the same SEXP syntax +for shell variables and command-line arguments. + + +Configuration API +================= + +This API is exported from package COMMON-LISP-CONFIGURATION. + +(initialize-source-registry) + will read the configuration and initialize all internal variables, + and return the new configuration. + +(clear-source-registry) + undoes any initialization. You might want to call that before you + dump an image that would be resumed with a different configuration, + and return an empty configuration. + Also will have a hook that allows clients will use to clear any cache + that depends on this configuration. + +(ensure-source-registry) + checks an initial variable to see whether the state is initialized + or cleared. In the former case, return current configuration; + in the latter, initialize. + ASDF will call this function at the start of (asdf:find-system). + +(process-source-registry X &optional inherit) + If X is a CONS, parse it as a SEXP in the configuration DSL, + and extend or override inheritted configuration. + If X is a STRING, first parse it into a SEXP with READ + (Alternate proposal: parse some shell-friendly text representation). + The inheritted configuration is provided in optional argument inherit, + itself a function that returns the previous configuration, with NIL + designating the default of #'ensure-source-registry-configuration. + Internally, initialize-source-registry-configuration can use this + with a series of functions for inheritted configuration. + + +Search Algorithm +================ + +* When a system is searched for, entries are processed in order. + +* If a given entry has exactly one match, the search stops successfully. + If a given entry contains no match, it is skipped. + If a given entry contains multiple matches, an error is thrown. + +* This later case does not change the semantics of ASDF in the case + where no recursion takes place, and ensures no undetected insanity + happens in the case where recursion is specified. XCVB has tested + this model, with success I believe. + +* When an entry is first processed, the implementation may cache + the contents of the directory (i.e. all files that may match anything.) + until the cache is explicitly flushed (see below). + + +Cache flushing +============== + +* The cache is flushed when function + (asdf:clear-system-search-cache) + is called. + +* When the configuration is (re)loaded, the cache is flushed. + + +Questioned Niceties +=================== + +I've been suggested the below features, but have rejected them, +for the sake of keeping ASDF no more complex than strictly necessary. + +* More syntactic sugar: synonyms for the configuration directives, such as + (:add-directory X) for (:directory X), or (:add-directory-hierarchy X) + or (:add-directory X :recurse t) for (:tree X). + +* The possibility to register individual files instead of directories. + +* Integrate Xach Beane's tilde expander into the parser, + or something similar that is shell-friendly or shell-compatible. + I'd rather keep ASDF minimal. But maybe this precisely keeps it + minimal by removing the need for evaluated entries that ASDF has? + i.e. uses of USER-HOMEDIR-PATHNAME and $SBCL_HOME + Hopefully, these are already superseded by the :default-registry + +* We may allow a shell-friendly colon-separated text-based syntax + for environment variables and command-line arguments. + If we only accept directories, not files, then all provided strings should + be considered with implicit / at the end before being parsed by + parse-namestring or such. An explicit // (as in TEXINPUTS) or /** + (as in zsh or some (non-standard) CL pathname extensions, but + requiring painful quotes from the shell) could specify recursion. + + +Additional Notes +================ + +With this specification, we can share configuration between ASDF and XCVB, +and maintain reasonable backwards compatibility in ASDF. + + -- Francois-Rene Rideau <fare@tunes.org>, Sun, 17 Jan 2010 15:53:31 -0500 diff --git a/asdf.lisp b/asdf.lisp index 4098436601ddcd8f87e9025a10b1a9d0c87b2c7c..200bee6649da209fd11dd0d7e2ea56adfbb5f2d7 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -137,7 +137,12 @@ #:*map-all-source-files* #:output-files-for-system-and-operation #:*enable-asdf-binary-locations* - #:implementation-specific-directory-name) + #:implementation-specific-directory-name + + #:initialize-source-registry + #:clear-source-registry + #:ensure-source-registry + #:process-source-registry) (:intern #:coerce-name #:getenv #:system-registered-p @@ -426,6 +431,57 @@ and NIL NAME and TYPE components" #+ecl (si:getenv x)) +(defun ensure-directory-pathname (pathspec) + "Converts the non-wild pathname designator PATHSPEC to directory form." + (let ((pathname (pathname pathspec))) + (when (wild-pathname-p pathname) + (error "Can't reliably convert wild pathnames.")) + (if (directory-pathname-p pathname) + pathname + (make-pathname :directory (append (or (pathname-directory pathname) + (list :relative)) + (list (file-namestring pathname))) + :name nil :type nil :version nil + :defaults pathname)))) + +(defun file-exists-p (pathname) + #+(or sbcl lispworks openmcl) + (probe-file pathname) + + #+(or allegro cmu) + (or (probe-file (ensure-directory-pathname pathname)) + (probe-file pathname)) + + #+clisp + (or (ignore-errors + (probe-file (pathname-as-file pathname))) + (ignore-errors + (let ((directory-form (ensure-directory-pathname pathname))) + (when (ext:probe-directory directory-form) + directory-form)))) + + #-(or sbcl cmu lispworks openmcl allegro clisp) + (error "list-directory not implemented")) + +(defun directory-exists-p (pathspec) + "Checks whether the file named by the pathname designator PATHSPEC +exists and if it is a directory. Returns its truename if this is the +case, NIL otherwise. The truename is returned in directory form as if +by ENSURE-DIRECTORY-PATHNAME." + #+:allegro + (and (excl:probe-directory pathspec) + (ensure-directory-pathname (truename pathspec))) + #+:lispworks + (and (lw:file-directory-p pathspec) + (ensure-directory-pathname (truename pathspec))) + #-(or :allegro :lispworks) + (let ((result (file-exists-p pathspec))) + (and result + (directory-pathname-p result) + result))) + +(defun every-string-p (x) + (every #'stringp x)) ;;;; ------------------------------------------------------------------------- ;;;; Classes, Conditions @@ -689,15 +745,6 @@ actually-existing directory." (and (check-one (pathname-name pathname)) (check-one (pathname-type pathname))))) -(defun ensure-directory-pathname (pathname) - (if (directory-pathname-p pathname) - pathname - (make-pathname :defaults pathname - :directory (append - (pathname-directory pathname) - (list (file-namestring pathname))) - :name nil :type nil :version nil))) - (defun sysdef-central-registry-search (system) (let ((name (coerce-name system)) (to-remove nil) @@ -2143,60 +2190,6 @@ with a different configuration, so the configuration would be re-read then." (defun expand-search-path (path) (mapcar #'pathname (expand-search-path-string path))) -(defun pathname-as-directory (pathspec) - "Converts the non-wild pathname designator PATHSPEC to directory -form." - (let ((pathname (pathname pathspec))) - (when (wild-pathname-p pathname) - (error "Can't reliably convert wild pathnames.")) - (cond ((not (directory-pathname-p pathspec)) - (make-pathname :directory (append (or (pathname-directory pathname) - (list :relative)) - (list (file-namestring pathname))) - :name nil - :type nil - :defaults pathname)) - (t pathname)))) - -(defun file-exists-p (pathname) - #+(or sbcl lispworks openmcl) - (probe-file pathname) - - #+(or allegro cmu) - (or (probe-file (pathname-as-directory pathname)) - (probe-file pathname)) - - #+clisp - (or (ignore-errors - (probe-file (pathname-as-file pathname))) - (ignore-errors - (let ((directory-form (pathname-as-directory pathname))) - (when (ext:probe-directory directory-form) - directory-form)))) - - #-(or sbcl cmu lispworks openmcl allegro clisp) - (error "list-directory not implemented")) - -(defun directory-exists-p (pathspec) - "Checks whether the file named by the pathname designator PATHSPEC -exists and if it is a directory. Returns its truename if this is the -case, NIL otherwise. The truename is returned in directory form as if -by PATHNAME-AS-DIRECTORY." - #+:allegro - (and (excl:probe-directory pathspec) - (pathname-as-directory (truename pathspec))) - #+:lispworks - (and (lw:file-directory-p pathspec) - (pathname-as-directory (truename pathspec))) - #-(or :allegro :lispworks) - (let ((result (file-exists-p pathspec))) - (and result - (directory-pathname-p result) - result))) - -(defun every-string-p (x) - (every #'stringp x)) - (defgeneric extract-registry-paths (type) (:documentation "")) (defmethod extract-registry-paths ((type (eql 'files))) @@ -2220,7 +2213,7 @@ by PATHNAME-AS-DIRECTORY." ((:directory :tree) #'directory-exists-p) ((:exclude) #'every-string-p) ((:default-registry - :accept-inherited-configuration + :inherit-configuration :ignore-inherited-configuration) nil))) (defun ensure-directory-trailing-slash (directory) @@ -2241,7 +2234,7 @@ by PATHNAME-AS-DIRECTORY." :unless (loop :for exclusion :in exclusions :when (search exclusion d) :return t) :collect d))) -(defun read-file (file) +(defun read-file-forms (file) (with-open-file (in file) (loop :with eof = (list nil) :for form = (read in nil eof) @@ -2264,7 +2257,7 @@ by PATHNAME-AS-DIRECTORY." (defun validate-file (file) (multiple-value-bind (registry count) - (read-file file) + (read-file-forms file) (cond ((> count 1) (error "~A:~%Exceeds maximum allowable expression: 1" file)) ((< (length (first registry)) 2) @@ -2275,19 +2268,19 @@ by PATHNAME-AS-DIRECTORY." (declare (ignore c)) (when (not (eql top :source-registry)) (error "~A: ~A:~%Invalid top-level directive~%" file top)) - (let ((accept-present (find :accept-inherited-configuration + (let ((accept-present (find :inherit-configuration rest :key #'first)) (ignore-present (find :ignore-inherited-configuration rest :key #'first))) (when (and accept-present ignore-present) (error "~A:~%Both ~S and ~S~%cannot exist in the same file.~%" file - :accept-inherited-configuration + :inherit-configuration :ignore-inherited-configuration)) (unless (or accept-present ignore-present) (error "~A:~%One of ~S or ~S~%directives not found.~%" file - :accept-inherited-configuration + :inherit-configuration :ignore-inherited-configuration))) (loop :for dir :in rest :do (validate-directive dir)))) @@ -2363,7 +2356,7 @@ by PATHNAME-AS-DIRECTORY." (collect-paths rest t)) ((:default-registry) (default-registry)) - ((:accept-inherited-configuration) + ((:inherit-configuration) (when reg (collect-paths reg))) ((:ignore-inherited-configuration) @@ -2372,19 +2365,12 @@ by PATHNAME-AS-DIRECTORY." (defun process-source-registry-path (path) (when (probe-file path) (validate-file path) - (multiple-value-bind (registry count) - (read-file path) - (destructuring-bind (((top &rest rest)) c) - (list registry count) - (declare (ignore c) - (ignorable top)) - (loop - :for reg :in rest - :nconc (process-source-registry reg)))))) + (loop :for entry :in (cdar (read-file-forms path)) + :nconc (process-source-registry entry)))) (defun process-source-registry-paths (paths) (loop :for path :in paths - :nconc (process-source-registry-path path))) + :nconc (process-source-registry-path path))) ;; Will read the configuration and initialize all internal variables, ;; and return the new configuration.