diff --git a/README b/README index 8714f50118e65e5e984282ab5cc3889f6f8ade7a..2dfce40c3d0d6499349372aa2b9022f28e42cc1a 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ -$Id: README,v 1.28 2003/02/04 17:01:24 dan_b Exp $ -*- Text -*- +$Id: README,v 1.29 2003/02/08 15:31:15 dan_b Exp $ -*- Text -*- asdf: another system definition facility @@ -519,7 +519,7 @@ option := :components component-list | :output-files method-form | :operation-done-p method-form | :depends-on ( {simple-component-name}* ) - | :serialize [ t | nil ] + | :serial [ t | nil ] | :in-order-to ( {dependency}+ ) component-list := ( {component-def}* ) @@ -567,6 +567,24 @@ supports :before methods, they may not do what you want them to - a after all the dependencies and sub-components have been processed, but before the component in question has been compiled. +**** Serial dependencies + +If the `:serial t' option is specified for a module, asdf will add +dependencies for each each child component, on all the children +textually preceding it. This is done as if by :depends-on + +:components ((:file "a") (:file "b") (:file "c")) +:serial t + +is equivalent to +:components ((:file "a") + (:file "b" :depends-on ("a")) + (:file "c" :depends-on ("a" "b"))) + + + +have all the + **** Source location The :pathname option is optional in all cases for native-syntax diff --git a/asdf.lisp b/asdf.lisp index 026e607c51b839d8139ab6869ae8577ae997407d..d40dcbe8bb29a82bf3dacbb0919d2ad445342dfb 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -1,4 +1,4 @@ -;;; This is asdf: Another System Definition Facility. $Revision: 1.57 $ +;;; This is asdf: Another System Definition Facility. $Revision: 1.58 $ ;;; ;;; Feedback, bug reports, and patches are all welcome: please mail to ;;; <cclan-list@lists.sf.net>. But note first that the canonical @@ -87,8 +87,7 @@ (in-package #:asdf) -;;; parse the cvs revision into something that might be vaguely useful. -(defvar *asdf-revision* (let* ((v "$Revision: 1.57 $") +(defvar *asdf-revision* (let* ((v "$Revision: 1.58 $") (colon (position #\: v)) (dot (position #\. v))) (and v colon dot @@ -806,6 +805,8 @@ Returns the new tree (which probably shares structure with the old one)" :key #'symbol-name :test 'equal) append (list name val))) +(defvar *serial-depends-on*) + (defun parse-component-form (parent options) (destructuring-bind (type name &rest rest &key @@ -813,54 +814,62 @@ Returns the new tree (which probably shares structure with the old one)" ;; remove-keys form. important to keep them in sync components pathname default-component-class perform explain output-files operation-done-p - depends-on serialize in-order-to + depends-on serial in-order-to ;; list ends &allow-other-keys) options - (declare (ignore serialize)) - ;; XXX add dependencies for serialized subcomponents - (let* ((other-args (remove-keys - '(components pathname default-component-class - perform explain output-files operation-done-p - depends-on serialize in-order-to) - rest)) - (ret - (or (find-component parent name) - (make-instance (class-for-type parent type))))) - (apply #'reinitialize-instance - ret - :name (coerce-name name) - :pathname pathname - :parent parent - :in-order-to (union-of-dependencies - in-order-to - `((compile-op (compile-op ,@depends-on)) - (load-op (load-op ,@depends-on)))) - :do-first `((compile-op (load-op ,@depends-on))) - other-args) - (when (typep ret 'module) - (setf (module-default-component-class ret) - (or default-component-class - (and (typep parent 'module) - (module-default-component-class parent))))) - (when components - (setf (module-components ret) - (mapcar (lambda (x) (parse-component-form ret x)) components))) - (loop for (n v) in `((perform ,perform) (explain ,explain) - (output-files ,output-files) - (operation-done-p ,operation-done-p)) - do (map 'nil - ;; this is inefficient as most of the stored - ;; methods will not be for this particular gf n - ;; But this is hardly performance-critical - (lambda (m) (remove-method (symbol-function n) m)) - (component-inline-methods ret)) - when v - do (destructuring-bind (op qual (o c) &body body) v - (pushnew - (eval `(defmethod ,n ,qual ((,o ,op) (,c (eql ,ret))) - ,@body)) - (component-inline-methods ret)))) - ret))) + (let* ((other-args (remove-keys + '(components pathname default-component-class + perform explain output-files operation-done-p + depends-on serial in-order-to) + rest)) + (ret + (or (find-component parent name) + (make-instance (class-for-type parent type))))) + (when (boundp '*serial-depends-on*) + (setf depends-on + (concatenate 'list *serial-depends-on* depends-on))) + (apply #'reinitialize-instance + ret + :name (coerce-name name) + :pathname pathname + :parent parent + other-args) + (when (typep ret 'module) + (setf (module-default-component-class ret) + (or default-component-class + (and (typep parent 'module) + (module-default-component-class parent)))) + (let ((*serial-depends-on* nil)) + (setf (module-components ret) + (loop for c-form in components + for c = (parse-component-form ret c-form) + collect c + if serial + do (push (component-name c) *serial-depends-on*))))) + + (setf (slot-value ret 'in-order-to) + (union-of-dependencies + in-order-to + `((compile-op (compile-op ,@depends-on)) + (load-op (load-op ,@depends-on)))) + (slot-value ret 'do-first) `((compile-op (load-op ,@depends-on)))) + + (loop for (n v) in `((perform ,perform) (explain ,explain) + (output-files ,output-files) + (operation-done-p ,operation-done-p)) + do (map 'nil + ;; this is inefficient as most of the stored + ;; methods will not be for this particular gf n + ;; But this is hardly performance-critical + (lambda (m) (remove-method (symbol-function n) m)) + (component-inline-methods ret)) + when v + do (destructuring-bind (op qual (o c) &body body) v + (pushnew + (eval `(defmethod ,n ,qual ((,o ,op) (,c (eql ,ret))) + ,@body)) + (component-inline-methods ret)))) + ret))) (defun resolve-symlinks (path) @@ -916,6 +925,25 @@ output to *trace-output*. Returns the shell's exit code." #-(or openmcl clisp lispworks allegro scl cmu sbcl) (error "RUN-SHELL-PROGRAM not implemented for this Lisp") )) - (pushnew :asdf *features*) + +#+sbcl +(eval-when (:compile-toplevel :load-toplevel :execute) + (when (sb-ext:posix-getenv "SBCL_BUILDING_CONTRIB") + (pushnew :sbcl-hooks-require *features*))) + +#+(and sbcl sbcl-hooks-require) +(progn + (defun module-provide-asdf (name) + (let ((system (asdf:find-system name nil))) + (when system + (asdf:operate 'asdf:load-op name) + (provide name)))) + + (pushnew + (merge-pathnames "systems/" + (truename (sb-ext:posix-getenv "SBCL_HOME"))) + *central-registry*) + + (pushnew 'module-provide-asdf sb-ext:*module-provider-functions*)) diff --git a/test/wild-module.script b/test/wild-module.script index d1b5d04dbc14eebf5947a05ec97481554809b41b..c5146934a2b92e3bd8137a8e0f4e7af556e74943 100644 --- a/test/wild-module.script +++ b/test/wild-module.script @@ -4,4 +4,4 @@ (load "../wild-modules") (setf asdf:*central-registry* '(*default-pathname-defaults*)) -(asdf:oos 'asdf:load-op 'wild-module) +(asdf:operate 'asdf:load-op 'wild-module) diff --git a/wild-modules.lisp b/wild-modules.lisp index 0a7ea3f51dcf445e676e9351165f42f759e045d6..0635f3a14090caf51262ef0c8970d052ed6f9745 100644 --- a/wild-modules.lisp +++ b/wild-modules.lisp @@ -7,9 +7,9 @@ :initform nil :initarg :component-options))) (defmethod (setf module-components) (new-value (module wild-module)) - (declare (ignore new-value)) - (sysdef-error "Cannot explicitly set wild-module ~A's components. Please ~ -use a wild pathname instead." module)) + (when new-value + (sysdef-error "Cannot explicitly set wild-module ~A's components. Please ~ +use a wild pathname instead." module))) (defmethod reinitialize-instance :after ((self wild-module) &key) (let ((pathname (slot-value self 'relative-pathname)))