source: release/1.2/source/tools/asdf.lisp @ 9219

Last change on this file since 9219 was 9219, checked in by gb, 11 years ago

synch from trunk

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 51.6 KB
Line 
1;;; This is asdf: Another System Definition Facility.  $Revision: 9219 $
2;;;
3;;; Feedback, bug reports, and patches are all welcome: please mail to
4;;; <cclan-list@lists.sf.net>.  But note first that the canonical
5;;; source for asdf is presently the cCLan CVS repository at
6;;; <URL:http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/cclan/asdf/>
7;;;
8;;; If you obtained this copy from anywhere else, and you experience
9;;; trouble using it, or find bugs, you may want to check at the
10;;; location above for a more recent version (and for documentation
11;;; and test files, if your copy came without them) before reporting
12;;; bugs.  There are usually two "supported" revisions - the CVS HEAD
13;;; is the latest development version, whereas the revision tagged
14;;; RELEASE may be slightly older but is considered `stable'
15
16;;; Copyright (c) 2001-2007 Daniel Barlow and contributors
17;;;
18;;; Permission is hereby granted, free of charge, to any person obtaining
19;;; a copy of this software and associated documentation files (the
20;;; "Software"), to deal in the Software without restriction, including
21;;; without limitation the rights to use, copy, modify, merge, publish,
22;;; distribute, sublicense, and/or sell copies of the Software, and to
23;;; permit persons to whom the Software is furnished to do so, subject to
24;;; the following conditions:
25;;;
26;;; The above copyright notice and this permission notice shall be
27;;; included in all copies or substantial portions of the Software.
28;;;
29;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
30;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
31;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
32;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
33;;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
34;;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
35;;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
36
37;;; the problem with writing a defsystem replacement is bootstrapping:
38;;; we can't use defsystem to compile it.  Hence, all in one file
39
40(defpackage #:asdf
41  (:export #:defsystem #:oos #:operate #:find-system #:run-shell-command
42           #:system-definition-pathname #:find-component ; miscellaneous
43           #:hyperdocumentation #:hyperdoc
44
45           #:compile-op #:load-op #:load-source-op #:test-system-version
46           #:test-op
47           #:operation                  ; operations
48           #:feature                    ; sort-of operation
49           #:version                    ; metaphorically sort-of an operation
50
51           #:input-files #:output-files #:perform       ; operation methods
52           #:operation-done-p #:explain
53
54           #:component #:source-file
55           #:c-source-file #:cl-source-file #:java-source-file
56           #:static-file
57           #:doc-file
58           #:html-file
59           #:text-file
60           #:source-file-type
61           #:module                     ; components
62           #:system
63           #:unix-dso
64
65           #:module-components          ; component accessors
66           #:component-pathname
67           #:component-relative-pathname
68           #:component-name
69           #:component-version
70           #:component-parent
71           #:component-property
72           #:component-system
73
74           #:component-depends-on
75
76           #:system-description
77           #:system-long-description
78           #:system-author
79           #:system-maintainer
80           #:system-license
81           #:system-licence
82           #:system-source-file
83           #:system-relative-pathname
84
85           #:operation-on-warnings
86           #:operation-on-failure
87
88           ;#:*component-parent-pathname*
89           #:*system-definition-search-functions*
90           #:*central-registry*         ; variables
91           #:*compile-file-warnings-behaviour*
92           #:*compile-file-failure-behaviour*
93           #:*asdf-revision*
94
95           #:operation-error #:compile-failed #:compile-warned #:compile-error
96           #:error-component #:error-operation
97           #:system-definition-error
98           #:missing-component
99           #:missing-dependency
100           #:circular-dependency        ; errors
101           #:duplicate-names
102
103           #:retry
104           #:accept                     ; restarts
105
106           #:preference-file-for-system/operation
107           #:load-preferences
108           )
109  (:use :cl))
110
111
112#+nil
113(error "The author of this file habitually uses #+nil to comment out ~
114        forms. But don't worry, it was unlikely to work in the New ~
115        Implementation of Lisp anyway")
116
117(in-package #:asdf)
118
119(defvar *asdf-revision* (let* ((v "$Revision: 9219 $")
120                               (colon (or (position #\: v) -1))
121                               (dot (position #\. v)))
122                          (and v colon dot
123                               (list (parse-integer v :start (1+ colon)
124                                                      :junk-allowed t)
125                                     (parse-integer v :start (1+ dot)
126                                                      :junk-allowed t)))))
127
128(defvar *compile-file-warnings-behaviour* :warn)
129
130(defvar *compile-file-failure-behaviour* #+sbcl :error #-sbcl :warn)
131
132(defvar *verbose-out* nil)
133
134(defparameter +asdf-methods+
135  '(perform explain output-files operation-done-p))
136
137;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
138;; utility stuff
139
140(defmacro aif (test then &optional else)
141  `(let ((it ,test)) (if it ,then ,else)))
142
143(defun pathname-sans-name+type (pathname)
144  "Returns a new pathname with same HOST, DEVICE, DIRECTORY as PATHNAME,
145and NIL NAME and TYPE components"
146  (make-pathname :name nil :type nil :defaults pathname))
147
148(define-modify-macro appendf (&rest args)
149  append "Append onto list")
150
151;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
152;; classes, condiitons
153
154(define-condition system-definition-error (error) ()
155  ;; [this use of :report should be redundant, but unfortunately it's not.
156  ;; cmucl's lisp::output-instance prefers the kernel:slot-class-print-function
157  ;; over print-object; this is always conditions::%print-condition for
158  ;; condition objects, which in turn does inheritance of :report options at
159  ;; run-time.  fortunately, inheritance means we only need this kludge here in
160  ;; order to fix all conditions that build on it.  -- rgr, 28-Jul-02.]
161  #+cmu (:report print-object))
162
163(define-condition formatted-system-definition-error (system-definition-error)
164  ((format-control :initarg :format-control :reader format-control)
165   (format-arguments :initarg :format-arguments :reader format-arguments))
166  (:report (lambda (c s)
167             (apply #'format s (format-control c) (format-arguments c)))))
168
169(define-condition circular-dependency (system-definition-error)
170  ((components :initarg :components :reader circular-dependency-components)))
171
172(define-condition duplicate-names (system-definition-error)
173  ((name :initarg :name :reader duplicate-names-name)))
174
175(define-condition missing-component (system-definition-error)
176  ((requires :initform "(unnamed)" :reader missing-requires :initarg :requires)
177   (version :initform nil :reader missing-version :initarg :version)
178   (parent :initform nil :reader missing-parent :initarg :parent)))
179
180(define-condition missing-dependency (missing-component)
181  ((required-by :initarg :required-by :reader missing-required-by)))
182
183(define-condition operation-error (error)
184  ((component :reader error-component :initarg :component)
185   (operation :reader error-operation :initarg :operation))
186  (:report (lambda (c s)
187             (format s "~@<erred while invoking ~A on ~A~@:>"
188                     (error-operation c) (error-component c)))))
189(define-condition compile-error (operation-error) ())
190(define-condition compile-failed (compile-error) ())
191(define-condition compile-warned (compile-error) ())
192
193(defclass component ()
194  ((name :accessor component-name :initarg :name :documentation
195         "Component name: designator for a string composed of portable pathname characters")
196   (version :accessor component-version :initarg :version)
197   (in-order-to :initform nil :initarg :in-order-to)
198   ;; XXX crap name
199   (do-first :initform nil :initarg :do-first)
200   ;; methods defined using the "inline" style inside a defsystem form:
201   ;; need to store them somewhere so we can delete them when the system
202   ;; is re-evaluated
203   (inline-methods :accessor component-inline-methods :initform nil)
204   (parent :initarg :parent :initform nil :reader component-parent)
205   ;; no direct accessor for pathname, we do this as a method to allow
206   ;; it to default in funky ways if not supplied
207   (relative-pathname :initarg :pathname)
208   (operation-times :initform (make-hash-table )
209                    :accessor component-operation-times)
210   ;; XXX we should provide some atomic interface for updating the
211   ;; component properties
212   (properties :accessor component-properties :initarg :properties
213               :initform nil)))
214
215;;;; methods: conditions
216
217(defmethod print-object ((c missing-dependency) s)
218  (format s "~@<~A, required by ~A~@:>"
219          (call-next-method c nil) (missing-required-by c)))
220
221(defun sysdef-error (format &rest arguments)
222  (error 'formatted-system-definition-error :format-control format :format-arguments arguments))
223
224;;;; methods: components
225
226(defmethod print-object ((c missing-component) s)
227  (format s "~@<component ~S not found~
228             ~@[ or does not match version ~A~]~
229             ~@[ in ~A~]~@:>"
230          (missing-requires c)
231          (missing-version c)
232          (when (missing-parent c)
233            (component-name (missing-parent c)))))
234
235(defgeneric component-system (component)
236  (:documentation "Find the top-level system containing COMPONENT"))
237
238(defmethod component-system ((component component))
239  (aif (component-parent component)
240       (component-system it)
241       component))
242
243(defmethod print-object ((c component) stream)
244  (print-unreadable-object (c stream :type t :identity t)
245    (ignore-errors
246      (prin1 (component-name c) stream))))
247
248(defclass module (component)
249  ((components :initform nil :accessor module-components :initarg :components)
250   ;; what to do if we can't satisfy a dependency of one of this module's
251   ;; components.  This allows a limited form of conditional processing
252   (if-component-dep-fails :initform :fail
253                           :accessor module-if-component-dep-fails
254                           :initarg :if-component-dep-fails)
255   (default-component-class :accessor module-default-component-class
256     :initform 'cl-source-file :initarg :default-component-class)))
257
258(defgeneric component-pathname (component)
259  (:documentation "Extracts the pathname applicable for a particular component."))
260
261(defun component-parent-pathname (component)
262  (aif (component-parent component)
263       (component-pathname it)
264       *default-pathname-defaults*))
265
266(defgeneric component-relative-pathname (component)
267  (:documentation "Extracts the relative pathname applicable for a particular component."))
268
269(defmethod component-relative-pathname ((component module))
270  (or (slot-value component 'relative-pathname)
271      (make-pathname
272       :directory `(:relative ,(component-name component))
273       :host (pathname-host (component-parent-pathname component)))))
274
275(defmethod component-pathname ((component component))
276  (let ((*default-pathname-defaults* (component-parent-pathname component)))
277    (merge-pathnames (component-relative-pathname component))))
278
279(defgeneric component-property (component property))
280
281(defmethod component-property ((c component) property)
282  (cdr (assoc property (slot-value c 'properties) :test #'equal)))
283
284(defgeneric (setf component-property) (new-value component property))
285
286(defmethod (setf component-property) (new-value (c component) property)
287  (let ((a (assoc property (slot-value c 'properties) :test #'equal)))
288    (if a
289        (setf (cdr a) new-value)
290        (setf (slot-value c 'properties)
291              (acons property new-value (slot-value c 'properties))))))
292
293(defclass system (module)
294  ((description :accessor system-description :initarg :description)
295   (long-description
296    :accessor system-long-description :initarg :long-description)
297   (author :accessor system-author :initarg :author)
298   (maintainer :accessor system-maintainer :initarg :maintainer)
299   (licence :accessor system-licence :initarg :licence
300            :accessor system-license :initarg :license)))
301
302;;; version-satisfies
303
304;;; with apologies to christophe rhodes ...
305(defun split (string &optional max (ws '(#\Space #\Tab)))
306  (flet ((is-ws (char) (find char ws)))
307    (nreverse
308     (let ((list nil) (start 0) (words 0) end)
309       (loop
310         (when (and max (>= words (1- max)))
311           (return (cons (subseq string start) list)))
312         (setf end (position-if #'is-ws string :start start))
313         (push (subseq string start end) list)
314         (incf words)
315         (unless end (return list))
316         (setf start (1+ end)))))))
317
318(defgeneric version-satisfies (component version))
319
320(defmethod version-satisfies ((c component) version)
321  (unless (and version (slot-boundp c 'version))
322    (return-from version-satisfies t))
323  (let ((x (mapcar #'parse-integer
324                   (split (component-version c) nil '(#\.))))
325        (y (mapcar #'parse-integer
326                   (split version nil '(#\.)))))
327    (labels ((bigger (x y)
328               (cond ((not y) t)
329                     ((not x) nil)
330                     ((> (car x) (car y)) t)
331                     ((= (car x) (car y))
332                      (bigger (cdr x) (cdr y))))))
333      (and (= (car x) (car y))
334           (or (not (cdr y)) (bigger (cdr x) (cdr y)))))))
335
336;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
337;;; finding systems
338
339(defvar *defined-systems* (make-hash-table :test 'equal))
340(defun coerce-name (name)
341  (typecase name
342    (component (component-name name))
343    (symbol (string-downcase (symbol-name name)))
344    (string name)
345    (t (sysdef-error "~@<invalid component designator ~A~@:>" name))))
346
347;;; for the sake of keeping things reasonably neat, we adopt a
348;;; convention that functions in this list are prefixed SYSDEF-
349
350(defvar *system-definition-search-functions*
351  '(sysdef-central-registry-search))
352
353(defun system-definition-pathname (system)
354  (some (lambda (x) (funcall x system))
355        *system-definition-search-functions*))
356
357(defvar *central-registry*
358  '(*default-pathname-defaults*
359    #+nil "/home/dan/src/sourceforge/cclan/asdf/systems/"
360    #+nil "telent:asdf;systems;"))
361
362(defun sysdef-central-registry-search (system)
363  (let ((name (coerce-name system)))
364    (block nil
365      (dolist (dir *central-registry*)
366        (let* ((defaults (eval dir))
367               (file (and defaults
368                          (make-pathname
369                           :defaults defaults :version :newest
370                           :name name :type "asd" :case :local))))
371          (if (and file (probe-file file))
372              (return file)))))))
373
374(defun make-temporary-package ()
375  (flet ((try (counter)
376           (ignore-errors
377             (make-package (format nil "ASDF~D" counter)
378                           :use '(:cl :asdf)))))
379    (do* ((counter 0 (+ counter 1))
380          (package (try counter) (try counter)))
381         (package package))))
382
383(defun find-system (name &optional (error-p t))
384  (let* ((name (coerce-name name))
385         (in-memory (gethash name *defined-systems*))
386         (on-disk (system-definition-pathname name)))
387    (when (and on-disk
388               (or (not in-memory)
389                   (< (car in-memory) (file-write-date on-disk))))
390      (let ((package (make-temporary-package)))
391        (unwind-protect
392             (let ((*package* package))
393               (format
394                *verbose-out*
395                "~&~@<; ~@;loading system definition from ~A into ~A~@:>~%"
396                ;; FIXME: This wants to be (ENOUGH-NAMESTRING
397                ;; ON-DISK), but CMUCL barfs on that.
398                on-disk
399                *package*)
400               (load on-disk))
401          (delete-package package))))
402    (let ((in-memory (gethash name *defined-systems*)))
403      (if in-memory
404          (progn (if on-disk (setf (car in-memory) (file-write-date on-disk)))
405                 (cdr in-memory))
406          (if error-p (error 'missing-component :requires name))))))
407
408(defun register-system (name system)
409  (format *verbose-out* "~&~@<; ~@;registering ~A as ~A~@:>~%" system name)
410  (setf (gethash (coerce-name  name) *defined-systems*)
411        (cons (get-universal-time) system)))
412
413(defun system-registered-p (name)
414  (gethash (coerce-name name) *defined-systems*))
415
416;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
417;;; finding components
418
419(defgeneric find-component (module name &optional version)
420  (:documentation "Finds the component with name NAME present in the
421MODULE module; if MODULE is nil, then the component is assumed to be a
422system."))
423
424(defmethod find-component ((module module) name &optional version)
425  (if (slot-boundp module 'components)
426      (let ((m (find name (module-components module)
427                     :test #'equal :key #'component-name)))
428        (if (and m (version-satisfies m version)) m))))
429
430
431;;; a component with no parent is a system
432(defmethod find-component ((module (eql nil)) name &optional version)
433  (let ((m (find-system name nil)))
434    (if (and m (version-satisfies m version)) m)))
435
436;;; component subclasses
437
438(defclass source-file (component) ())
439
440(defclass cl-source-file (source-file) ())
441(defclass c-source-file (source-file) ())
442(defclass java-source-file (source-file) ())
443(defclass static-file (source-file) ())
444(defclass doc-file (static-file) ())
445(defclass html-file (doc-file) ())
446
447(defgeneric source-file-type (component system))
448(defmethod source-file-type ((c cl-source-file) (s module)) "lisp")
449(defmethod source-file-type ((c c-source-file) (s module)) "c")
450(defmethod source-file-type ((c java-source-file) (s module)) "java")
451(defmethod source-file-type ((c html-file) (s module)) "html")
452(defmethod source-file-type ((c static-file) (s module)) nil)
453
454(defmethod component-relative-pathname ((component source-file))
455  (let ((relative-pathname (slot-value component 'relative-pathname)))
456    (if relative-pathname
457        (merge-pathnames
458         relative-pathname
459         (make-pathname
460          :type (source-file-type component (component-system component))))
461        (let* ((*default-pathname-defaults*
462                (component-parent-pathname component))
463               (name-type
464                (make-pathname
465                 :name (component-name component)
466                 :type (source-file-type component
467                                         (component-system component)))))
468          name-type))))
469
470;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
471;;; operations
472
473;;; one of these is instantiated whenever (operate ) is called
474
475(defclass operation ()
476  ((forced :initform nil :initarg :force :accessor operation-forced)
477   (original-initargs :initform nil :initarg :original-initargs
478                      :accessor operation-original-initargs)
479   (visited-nodes :initform nil :accessor operation-visited-nodes)
480   (visiting-nodes :initform nil :accessor operation-visiting-nodes)
481   (parent :initform nil :initarg :parent :accessor operation-parent)))
482
483(defmethod print-object ((o operation) stream)
484  (print-unreadable-object (o stream :type t :identity t)
485    (ignore-errors
486      (prin1 (operation-original-initargs o) stream))))
487
488(defmethod shared-initialize :after ((operation operation) slot-names
489                                     &key force
490                                     &allow-other-keys)
491  (declare (ignore slot-names force))
492  ;; empty method to disable initarg validity checking
493  )
494
495(defgeneric perform (operation component))
496(defgeneric operation-done-p (operation component))
497(defgeneric explain (operation component))
498(defgeneric output-files (operation component))
499(defgeneric input-files (operation component))
500
501(defun node-for (o c)
502  (cons (class-name (class-of o)) c))
503
504(defgeneric operation-ancestor (operation)
505  (:documentation
506   "Recursively chase the operation's parent pointer until we get to
507the head of the tree"))
508
509(defmethod operation-ancestor ((operation operation))
510  (aif (operation-parent operation)
511       (operation-ancestor it)
512       operation))
513
514
515(defun make-sub-operation (c o dep-c dep-o)
516  (let* ((args (copy-list (operation-original-initargs o)))
517         (force-p (getf args :force)))
518    ;; note explicit comparison with T: any other non-NIL force value
519    ;; (e.g. :recursive) will pass through
520    (cond ((and (null (component-parent c))
521                (null (component-parent dep-c))
522                (not (eql c dep-c)))
523           (when (eql force-p t)
524             (setf (getf args :force) nil))
525           (apply #'make-instance dep-o
526                  :parent o
527                  :original-initargs args args))
528          ((subtypep (type-of o) dep-o)
529           o)
530          (t
531           (apply #'make-instance dep-o
532                  :parent o :original-initargs args args)))))
533
534
535(defgeneric visit-component (operation component data))
536
537(defmethod visit-component ((o operation) (c component) data)
538  (unless (component-visited-p o c)
539    (push (cons (node-for o c) data)
540          (operation-visited-nodes (operation-ancestor o)))))
541
542(defgeneric component-visited-p (operation component))
543
544(defmethod component-visited-p ((o operation) (c component))
545  (assoc (node-for o c)
546         (operation-visited-nodes (operation-ancestor o))
547         :test 'equal))
548
549(defgeneric (setf visiting-component) (new-value operation component))
550
551(defmethod (setf visiting-component) (new-value operation component)
552  ;; MCL complains about unused lexical variables
553  (declare (ignorable new-value operation component)))
554
555(defmethod (setf visiting-component) (new-value (o operation) (c component))
556  (let ((node (node-for o c))
557        (a (operation-ancestor o)))
558    (if new-value
559        (pushnew node (operation-visiting-nodes a) :test 'equal)
560        (setf (operation-visiting-nodes a)
561              (remove node  (operation-visiting-nodes a) :test 'equal)))))
562
563(defgeneric component-visiting-p (operation component))
564
565(defmethod component-visiting-p ((o operation) (c component))
566  (let ((node (cons o c)))
567    (member node (operation-visiting-nodes (operation-ancestor o))
568            :test 'equal)))
569
570(defgeneric component-depends-on (operation component)
571  (:documentation
572   "Returns a list of dependencies needed by the component to perform
573    the operation.  A dependency has one of the following forms:
574
575      (<operation> <component>*), where <operation> is a class
576        designator and each <component> is a component
577        designator, which means that the component depends on
578        <operation> having been performed on each <component>; or
579
580      (FEATURE <feature>), which means that the component depends
581        on <feature>'s presence in *FEATURES*.
582
583    Methods specialized on subclasses of existing component types
584    should usually append the results of CALL-NEXT-METHOD to the
585    list."))
586
587(defmethod component-depends-on ((op-spec symbol) (c component))
588  (component-depends-on (make-instance op-spec) c))
589
590(defmethod component-depends-on ((o operation) (c component))
591  (cdr (assoc (class-name (class-of o))
592              (slot-value c 'in-order-to))))
593
594(defgeneric component-self-dependencies (operation component))
595
596(defmethod component-self-dependencies ((o operation) (c component))
597  (let ((all-deps (component-depends-on o c)))
598    (remove-if-not (lambda (x)
599                     (member (component-name c) (cdr x) :test #'string=))
600                   all-deps)))
601
602(defmethod input-files ((operation operation) (c component))
603  (let ((parent (component-parent c))
604        (self-deps (component-self-dependencies operation c)))
605    (if self-deps
606        (mapcan (lambda (dep)
607                  (destructuring-bind (op name) dep
608                    (output-files (make-instance op)
609                                  (find-component parent name))))
610                self-deps)
611        ;; no previous operations needed?  I guess we work with the
612        ;; original source file, then
613        (list (component-pathname c)))))
614
615(defmethod input-files ((operation operation) (c module)) nil)
616
617(defmethod operation-done-p ((o operation) (c component))
618  (flet ((fwd-or-return-t (file)
619           ;; if FILE-WRITE-DATE returns NIL, it's possible that the
620           ;; user or some other agent has deleted an input file.  If
621           ;; that's the case, well, that's not good, but as long as
622           ;; the operation is otherwise considered to be done we
623           ;; could continue and survive.
624           (let ((date (file-write-date file)))
625             (cond
626               (date)
627               (t
628                (warn "~@<Missing FILE-WRITE-DATE for ~S: treating ~
629                       operation ~S on component ~S as done.~@:>"
630                      file o c)
631                (return-from operation-done-p t))))))
632    (let ((out-files (output-files o c))
633          (in-files (input-files o c)))
634      (cond ((and (not in-files) (not out-files))
635             ;; arbitrary decision: an operation that uses nothing to
636             ;; produce nothing probably isn't doing much
637             t)
638            ((not out-files)
639             (let ((op-done
640                    (gethash (type-of o)
641                             (component-operation-times c))))
642               (and op-done
643                    (>= op-done
644                        (apply #'max
645                               (mapcar #'fwd-or-return-t in-files))))))
646            ((not in-files) nil)
647            (t
648             (and
649              (every #'probe-file out-files)
650              (> (apply #'min (mapcar #'file-write-date out-files))
651                 (apply #'max (mapcar #'fwd-or-return-t in-files)))))))))
652
653;;; So you look at this code and think "why isn't it a bunch of
654;;; methods".  And the answer is, because standard method combination
655;;; runs :before methods most->least-specific, which is back to front
656;;; for our purposes.  And CLISP doesn't have non-standard method
657;;; combinations, so let's keep it simple and aspire to portability
658
659(defgeneric traverse (operation component))
660(defmethod traverse ((operation operation) (c component))
661  (let ((forced nil))
662    (labels ((do-one-dep (required-op required-c required-v)
663               (let* ((dep-c (or (find-component
664                                  (component-parent c)
665                                  ;; XXX tacky.  really we should build the
666                                  ;; in-order-to slot with canonicalized
667                                  ;; names instead of coercing this late
668                                  (coerce-name required-c) required-v)
669                                 (error 'missing-dependency
670                                        :required-by c
671                                        :version required-v
672                                        :requires required-c)))
673                      (op (make-sub-operation c operation dep-c required-op)))
674                 (traverse op dep-c)))
675             (do-dep (op dep)
676               (cond ((eq op 'feature)
677                      (or (member (car dep) *features*)
678                          (error 'missing-dependency
679                                 :required-by c
680                                 :requires (car dep)
681                                 :version nil)))
682                     (t
683                      (dolist (d dep)
684                        (cond ((consp d)
685                               (assert (string-equal
686                                        (symbol-name (first d))
687                                        "VERSION"))
688                               (appendf forced
689                                        (do-one-dep op (second d) (third d))))
690                              (t
691                               (appendf forced (do-one-dep op d nil)))))))))
692      (aif (component-visited-p operation c)
693           (return-from traverse
694             (if (cdr it) (list (cons 'pruned-op c)) nil)))
695      ;; dependencies
696      (if (component-visiting-p operation c)
697          (error 'circular-dependency :components (list c)))
698      (setf (visiting-component operation c) t)
699      (loop for (required-op . deps) in (component-depends-on operation c)
700            do (do-dep required-op deps))
701      ;; constituent bits
702      (let ((module-ops
703             (when (typep c 'module)
704               (let ((at-least-one nil)
705                     (forced nil)
706                     (error nil))
707                 (loop for kid in (module-components c)
708                       do (handler-case
709                              (appendf forced (traverse operation kid ))
710                            (missing-dependency (condition)
711                              (if (eq (module-if-component-dep-fails c) :fail)
712                                  (error condition))
713                              (setf error condition))
714                            (:no-error (c)
715                              (declare (ignore c))
716                              (setf at-least-one t))))
717                 (when (and (eq (module-if-component-dep-fails c) :try-next)
718                            (not at-least-one))
719                   (error error))
720                 forced))))
721        ;; now the thing itself
722        (when (or forced module-ops
723                  (not (operation-done-p operation c))
724                  (let ((f (operation-forced (operation-ancestor operation))))
725                    (and f (or (not (consp f))
726                               (member (component-name
727                                        (operation-ancestor operation))
728                                       (mapcar #'coerce-name f)
729                                       :test #'string=)))))
730          (let ((do-first (cdr (assoc (class-name (class-of operation))
731                                      (slot-value c 'do-first)))))
732            (loop for (required-op . deps) in do-first
733                  do (do-dep required-op deps)))
734          (setf forced (append (delete 'pruned-op forced :key #'car)
735                               (delete 'pruned-op module-ops :key #'car)
736                               (list (cons operation c))))))
737      (setf (visiting-component operation c) nil)
738      (visit-component operation c (and forced t))
739      forced)))
740
741
742(defmethod perform ((operation operation) (c source-file))
743  (sysdef-error
744   "~@<required method PERFORM not implemented ~
745    for operation ~A, component ~A~@:>"
746   (class-of operation) (class-of c)))
747
748(defmethod perform ((operation operation) (c module))
749  nil)
750
751(defmethod explain ((operation operation) (component component))
752  (format *verbose-out* "~&;;; ~A on ~A~%" operation component))
753
754;;; compile-op
755
756(defclass compile-op (operation)
757  ((proclamations :initarg :proclamations :accessor compile-op-proclamations :initform nil)
758   (on-warnings :initarg :on-warnings :accessor operation-on-warnings
759                :initform *compile-file-warnings-behaviour*)
760   (on-failure :initarg :on-failure :accessor operation-on-failure
761               :initform *compile-file-failure-behaviour*)))
762
763(defmethod perform :before ((operation compile-op) (c source-file))
764  (map nil #'ensure-directories-exist (output-files operation c)))
765
766(defmethod perform :after ((operation operation) (c component))
767  (setf (gethash (type-of operation) (component-operation-times c))
768        (get-universal-time))
769  (load-preferences c operation))
770
771;;; perform is required to check output-files to find out where to put
772;;; its answers, in case it has been overridden for site policy
773(defmethod perform ((operation compile-op) (c cl-source-file))
774  #-:broken-fasl-loader
775  (let ((source-file (component-pathname c))
776        (output-file (car (output-files operation c))))
777    (multiple-value-bind (output warnings-p failure-p)
778        (compile-file source-file :output-file output-file)
779      (when warnings-p
780        (case (operation-on-warnings operation)
781          (:warn (warn
782                  "~@<COMPILE-FILE warned while performing ~A on ~A.~@:>"
783                  operation c))
784          (:error (error 'compile-warned :component c :operation operation))
785          (:ignore nil)))
786      (when failure-p
787        (case (operation-on-failure operation)
788          (:warn (warn
789                  "~@<COMPILE-FILE failed while performing ~A on ~A.~@:>"
790                  operation c))
791          (:error (error 'compile-failed :component c :operation operation))
792          (:ignore nil)))
793      (unless output
794        (error 'compile-error :component c :operation operation)))))
795
796(defmethod output-files ((operation compile-op) (c cl-source-file))
797  #-:broken-fasl-loader (list (compile-file-pathname (component-pathname c)))
798  #+:broken-fasl-loader (list (component-pathname c)))
799
800(defmethod perform ((operation compile-op) (c static-file))
801  nil)
802
803(defmethod output-files ((operation compile-op) (c static-file))
804  nil)
805
806(defmethod input-files ((op compile-op) (c static-file))
807  nil)
808
809
810;;; load-op
811
812(defclass basic-load-op (operation) ())
813
814(defclass load-op (basic-load-op) ())
815
816(defmethod perform ((o load-op) (c cl-source-file))
817  (mapcar #'load (input-files o c)))
818
819(defmethod perform ((operation load-op) (c static-file))
820  nil)
821(defmethod operation-done-p ((operation load-op) (c static-file))
822  t)
823
824(defmethod output-files ((o operation) (c component))
825  nil)
826
827(defmethod component-depends-on ((operation load-op) (c component))
828  (cons (list 'compile-op (component-name c))
829        (call-next-method)))
830
831;;; load-source-op
832
833(defclass load-source-op (basic-load-op) ())
834
835(defmethod perform ((o load-source-op) (c cl-source-file))
836  (let ((source (component-pathname c)))
837    (setf (component-property c 'last-loaded-as-source)
838          (and (load source)
839               (get-universal-time)))))
840
841(defmethod perform ((operation load-source-op) (c static-file))
842  nil)
843
844(defmethod output-files ((operation load-source-op) (c component))
845  nil)
846
847;;; FIXME: we simply copy load-op's dependencies.  this is Just Not Right.
848(defmethod component-depends-on ((o load-source-op) (c component))
849  (let ((what-would-load-op-do (cdr (assoc 'load-op
850                                           (slot-value c 'in-order-to)))))
851    (mapcar (lambda (dep)
852              (if (eq (car dep) 'load-op)
853                  (cons 'load-source-op (cdr dep))
854                  dep))
855            what-would-load-op-do)))
856
857(defmethod operation-done-p ((o load-source-op) (c source-file))
858  (if (or (not (component-property c 'last-loaded-as-source))
859          (> (file-write-date (component-pathname c))
860             (component-property c 'last-loaded-as-source)))
861      nil t))
862
863(defclass test-op (operation) ())
864
865(defmethod perform ((operation test-op) (c component))
866  nil)
867
868(defgeneric load-preferences (system operation)
869  (:documentation
870   "Called to load system preferences after <perform operation
871system>. Typical uses are to set parameters that don't exist until
872after the system has been loaded."))
873
874(defgeneric preference-file-for-system/operation (system operation)
875  (:documentation
876   "Returns the pathname of the preference file for this system.
877Called by 'load-preferences to determine what file to load."))
878
879(defmethod load-preferences ((s t) (operation t))
880  ;; do nothing
881  (values))
882
883(defmethod load-preferences ((s system) (operation basic-load-op))
884  (let* ((*package* (find-package :common-lisp))
885         (file (probe-file (preference-file-for-system/operation s operation))))
886    (when file
887      (when *verbose-out*
888        (format *verbose-out*
889                "~&~@<; ~@;loading preferences for ~A/~(~A~) from ~A~@:>~%"
890                (component-name s)
891                (type-of operation) file))
892      (load file))))
893
894(defmethod preference-file-for-system/operation ((system t) (operation t))
895  ;; cope with anything other than systems
896  (preference-file-for-system/operation (find-system system t) operation))
897
898(defmethod preference-file-for-system/operation ((s system) (operation t))
899  (let ((*default-pathname-defaults*
900         (make-pathname :name nil :type nil
901                        :defaults *default-pathname-defaults*)))
902     (merge-pathnames
903      (make-pathname :name (component-name s)
904                     :type "lisp"
905                     :directory '(:relative ".asdf"))
906      (truename (user-homedir-pathname)))))
907
908;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
909;;; invoking operations
910
911(defvar *operate-docstring*
912  "Operate does three things:
913
9141. It creates an instance of `operation-class` using any keyword parameters
915as initargs.
9162. It finds the  asdf-system specified by `system` (possibly loading
917it from disk).
9183. It then calls `traverse` with the operation and system as arguments
919
920The traverse operation is wrapped in `with-compilation-unit` and error
921handling code. If a `version` argument is supplied, then operate also
922ensures that the system found satisfies it using the `version-satisfies`
923method.")
924
925(defun operate (operation-class system &rest args &key (verbose t) version
926                &allow-other-keys)
927  (let* ((op (apply #'make-instance operation-class
928                    :original-initargs args
929                    args))
930         (*verbose-out* (if verbose *standard-output* (make-broadcast-stream)))
931         (system (if (typep system 'component) system (find-system system))))
932    (unless (version-satisfies system version)
933      (error 'missing-component :requires system :version version))
934    (let ((steps (traverse op system)))
935      (with-compilation-unit ()
936        (loop for (op . component) in steps do
937                 (loop
938                   (restart-case
939                       (progn (perform op component)
940                              (return))
941                     (retry ()
942                       :report
943                       (lambda (s)
944                         (format s "~@<Retry performing ~S on ~S.~@:>"
945                                 op component)))
946                     (accept ()
947                       :report
948                       (lambda (s)
949                         (format s "~@<Continue, treating ~S on ~S as ~
950                                   having been successful.~@:>"
951                                 op component))
952                       (setf (gethash (type-of op)
953                                      (component-operation-times component))
954                             (get-universal-time))
955                       (return)))))))))
956
957(setf (documentation 'operate 'function)
958      *operate-docstring*)
959
960(defun oos (operation-class system &rest args &key force (verbose t) version)
961  (declare (ignore force verbose version))
962  (apply #'operate operation-class system args))
963
964(setf (documentation 'oos 'function)
965      (format nil
966              "Short for _operate on system_ and an alias for the `operate` function. ~&~&~a"
967              *operate-docstring*))
968
969;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
970;;; syntax
971
972(defun remove-keyword (key arglist)
973  (labels ((aux (key arglist)
974             (cond ((null arglist) nil)
975                   ((eq key (car arglist)) (cddr arglist))
976                   (t (cons (car arglist) (cons (cadr arglist)
977                                                (remove-keyword
978                                                 key (cddr arglist))))))))
979    (aux key arglist)))
980
981(defmacro defsystem (name &body options)
982  (destructuring-bind (&key (pathname nil pathname-arg-p) (class 'system)
983                            &allow-other-keys)
984      options
985    (let ((component-options (remove-keyword :class options)))
986      `(progn
987         ;; system must be registered before we parse the body, otherwise
988         ;; we recur when trying to find an existing system of the same name
989         ;; to reuse options (e.g. pathname) from
990         (let ((s (system-registered-p ',name)))
991           (cond ((and s (eq (type-of (cdr s)) ',class))
992                  (setf (car s) (get-universal-time)))
993                 (s
994                  #+clisp
995                  (sysdef-error "Cannot redefine the existing system ~A with a different class" s)
996                  #-clisp
997                  (change-class (cdr s) ',class))
998                 (t
999                  (register-system (quote ,name)
1000                                   (make-instance ',class :name ',name)))))
1001         (parse-component-form nil (apply
1002                                    #'list
1003                                    :module (coerce-name ',name)
1004                                    :pathname
1005                                    ;; to avoid a note about unreachable code
1006                                    ,(if pathname-arg-p
1007                                         pathname
1008                                         `(or (when *load-truename*
1009                                                (pathname-sans-name+type
1010                                                 (resolve-symlinks
1011                                                  *load-truename*)))
1012                                              *default-pathname-defaults*))
1013                                    ',component-options))))))
1014
1015
1016(defun class-for-type (parent type)
1017  (let* ((extra-symbols (list (find-symbol (symbol-name type) *package*)
1018                              (find-symbol (symbol-name type)
1019                                           (load-time-value
1020                                            (package-name :asdf)))))
1021         (class (dolist (symbol (if (keywordp type)
1022                                    extra-symbols
1023                                    (cons type extra-symbols)))
1024                  (when (and symbol
1025                             (find-class symbol nil)
1026                             (subtypep symbol 'component))
1027                    (return (find-class symbol))))))
1028    (or class
1029        (and (eq type :file)
1030             (or (module-default-component-class parent)
1031                 (find-class 'cl-source-file)))
1032        (sysdef-error "~@<don't recognize component type ~A~@:>" type))))
1033
1034(defun maybe-add-tree (tree op1 op2 c)
1035  "Add the node C at /OP1/OP2 in TREE, unless it's there already.
1036Returns the new tree (which probably shares structure with the old one)"
1037  (let ((first-op-tree (assoc op1 tree)))
1038    (if first-op-tree
1039        (progn
1040          (aif (assoc op2 (cdr first-op-tree))
1041               (if (find c (cdr it))
1042                   nil
1043                   (setf (cdr it) (cons c (cdr it))))
1044               (setf (cdr first-op-tree)
1045                     (acons op2 (list c) (cdr first-op-tree))))
1046          tree)
1047        (acons op1 (list (list op2 c)) tree))))
1048
1049(defun union-of-dependencies (&rest deps)
1050  (let ((new-tree nil))
1051    (dolist (dep deps)
1052      (dolist (op-tree dep)
1053        (dolist (op  (cdr op-tree))
1054          (dolist (c (cdr op))
1055            (setf new-tree
1056                  (maybe-add-tree new-tree (car op-tree) (car op) c))))))
1057    new-tree))
1058
1059
1060(defun remove-keys (key-names args)
1061  (loop for ( name val ) on args by #'cddr
1062        unless (member (symbol-name name) key-names
1063                       :key #'symbol-name :test 'equal)
1064        append (list name val)))
1065
1066(defvar *serial-depends-on*)
1067
1068(defun parse-component-form (parent options)
1069
1070  (destructuring-bind
1071        (type name &rest rest &key
1072              ;; the following list of keywords is reproduced below in the
1073              ;; remove-keys form.  important to keep them in sync
1074              components pathname default-component-class
1075              perform explain output-files operation-done-p
1076              weakly-depends-on
1077              depends-on serial in-order-to
1078              ;; list ends
1079              &allow-other-keys) options
1080    (declare (ignorable perform explain output-files operation-done-p))
1081    (check-component-input type name weakly-depends-on depends-on components in-order-to)
1082
1083    (when (and parent
1084               (find-component parent name)
1085               ;; ignore the same object when rereading the defsystem
1086               (not
1087                (typep (find-component parent name)
1088                       (class-for-type parent type))))
1089      (error 'duplicate-names :name name))
1090
1091    (let* ((other-args (remove-keys
1092                        '(components pathname default-component-class
1093                          perform explain output-files operation-done-p
1094                          weakly-depends-on
1095                          depends-on serial in-order-to)
1096                        rest))
1097           (ret
1098            (or (find-component parent name)
1099                (make-instance (class-for-type parent type)))))
1100      (when weakly-depends-on
1101        (setf depends-on (append depends-on (remove-if (complement #'find-system) weakly-depends-on))))
1102      (when (boundp '*serial-depends-on*)
1103        (setf depends-on
1104              (concatenate 'list *serial-depends-on* depends-on)))
1105      (apply #'reinitialize-instance ret
1106             :name (coerce-name name)
1107             :pathname pathname
1108             :parent parent
1109             other-args)
1110      (when (typep ret 'module)
1111        (setf (module-default-component-class ret)
1112              (or default-component-class
1113                  (and (typep parent 'module)
1114                       (module-default-component-class parent))))
1115        (let ((*serial-depends-on* nil))
1116          (setf (module-components ret)
1117                (loop for c-form in components
1118                      for c = (parse-component-form ret c-form)
1119                      collect c
1120                      if serial
1121                      do (push (component-name c) *serial-depends-on*))))
1122
1123        ;; check for duplicate names
1124        (let ((name-hash (make-hash-table :test #'equal)))
1125          (loop for c in (module-components ret)
1126                do
1127                (if (gethash (component-name c)
1128                             name-hash)
1129                    (error 'duplicate-names
1130                           :name (component-name c))
1131                    (setf (gethash (component-name c)
1132                                   name-hash)
1133                          t)))))
1134
1135      (setf (slot-value ret 'in-order-to)
1136            (union-of-dependencies
1137             in-order-to
1138             `((compile-op (compile-op ,@depends-on))
1139               (load-op (load-op ,@depends-on))))
1140            (slot-value ret 'do-first) `((compile-op (load-op ,@depends-on))))
1141
1142      (%remove-component-inline-methods ret rest)
1143
1144      ret)))
1145
1146(defun %remove-component-inline-methods (ret rest)
1147  (loop for name in +asdf-methods+
1148        do (map 'nil
1149                ;; this is inefficient as most of the stored
1150                ;; methods will not be for this particular gf n
1151                ;; But this is hardly performance-critical
1152                (lambda (m)
1153                  (remove-method (symbol-function name) m))
1154                (component-inline-methods ret)))
1155  ;; clear methods, then add the new ones
1156  (setf (component-inline-methods ret) nil)
1157  (loop for name in +asdf-methods+
1158        for v = (getf rest (intern (symbol-name name) :keyword))
1159        when v do
1160        (destructuring-bind (op qual (o c) &body body) v
1161          (pushnew
1162           (eval `(defmethod ,name ,qual ((,o ,op) (,c (eql ,ret)))
1163                             ,@body))
1164           (component-inline-methods ret)))))
1165
1166(defun check-component-input (type name weakly-depends-on depends-on components in-order-to)
1167  "A partial test of the values of a component."
1168  (when weakly-depends-on (warn "We got one! XXXXX"))
1169  (unless (listp depends-on)
1170    (sysdef-error-component ":depends-on must be a list."
1171                            type name depends-on))
1172  (unless (listp weakly-depends-on)
1173    (sysdef-error-component ":weakly-depends-on must be a list."
1174                            type name weakly-depends-on))
1175  (unless (listp components)
1176    (sysdef-error-component ":components must be NIL or a list of components."
1177                            type name components))
1178  (unless (and (listp in-order-to) (listp (car in-order-to)))
1179    (sysdef-error-component ":in-order-to must be NIL or a list of components."
1180                            type name in-order-to)))
1181
1182(defun sysdef-error-component (msg type name value)
1183  (sysdef-error (concatenate 'string msg
1184                             "~&The value specified for ~(~A~) ~A is ~W")
1185                type name value))
1186
1187(defun resolve-symlinks (path)
1188  #-allegro (truename path)
1189  #+allegro (excl:pathname-resolve-symbolic-links path)
1190  )
1191
1192;;; optional extras
1193
1194;;; run-shell-command functions for other lisp implementations will be
1195;;; gratefully accepted, if they do the same thing.  If the docstring
1196;;; is ambiguous, send a bug report
1197
1198(defun run-shell-command (control-string &rest args)
1199  "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
1200synchronously execute the result using a Bourne-compatible shell, with
1201output to *VERBOSE-OUT*.  Returns the shell's exit code."
1202  (let ((command (apply #'format nil control-string args)))
1203    (format *verbose-out* "; $ ~A~%" command)
1204    #+sbcl
1205    (sb-ext:process-exit-code
1206     (sb-ext:run-program
1207      #+win32 "sh" #-win32 "/bin/sh"
1208      (list  "-c" command)
1209      #+win32 #+win32 :search t
1210      :input nil :output *verbose-out*))
1211
1212    #+(or cmu scl)
1213    (ext:process-exit-code
1214     (ext:run-program
1215      "/bin/sh"
1216      (list  "-c" command)
1217      :input nil :output *verbose-out*))
1218
1219    #+allegro
1220    (excl:run-shell-command command :input nil :output *verbose-out*)
1221
1222    #+lispworks
1223    (system:call-system-showing-output
1224     command
1225     :shell-type "/bin/sh"
1226     :output-stream *verbose-out*)
1227
1228    #+clisp                     ;XXX not exactly *verbose-out*, I know
1229    (ext:run-shell-command  command :output :terminal :wait t)
1230
1231    #+openmcl
1232    (nth-value 1
1233               (ccl:external-process-status
1234                (ccl:run-program "/bin/sh" (list "-c" command)
1235                                 :input nil :output *verbose-out*
1236                                 :wait t)))
1237    #+ecl ;; courtesy of Juan Jose Garcia Ripoll
1238    (si:system command)
1239    #-(or openmcl clisp lispworks allegro scl cmu sbcl ecl)
1240    (error "RUN-SHELL-PROGRAM not implemented for this Lisp")
1241    ))
1242
1243
1244(defgeneric hyperdocumentation (package name doc-type))
1245(defmethod hyperdocumentation ((package symbol) name doc-type)
1246  (hyperdocumentation (find-package package) name doc-type))
1247
1248(defun hyperdoc (name doc-type)
1249  (hyperdocumentation (symbol-package name) name doc-type))
1250
1251(defun system-source-file (system-name)
1252  (let ((system (asdf:find-system system-name)))
1253    (make-pathname
1254     :type "asd"
1255     :name (asdf:component-name system)
1256     :defaults (asdf:component-relative-pathname system))))
1257
1258(defun system-source-directory (system-name)
1259  (make-pathname :name nil
1260                 :type nil
1261                 :defaults (system-source-file system-name)))
1262
1263(defun system-relative-pathname (system pathname &key name type)
1264  (let ((directory (pathname-directory pathname)))
1265    (when (eq (car directory) :absolute)
1266      (setf (car directory) :relative))
1267    (merge-pathnames
1268     (make-pathname :name (or name (pathname-name pathname))
1269                    :type (or type (pathname-type pathname))
1270                    :directory directory)
1271     (system-source-directory system))))
1272
1273
1274(pushnew :asdf *features*)
1275
1276#+sbcl
1277(eval-when (:compile-toplevel :load-toplevel :execute)
1278  (when (sb-ext:posix-getenv "SBCL_BUILDING_CONTRIB")
1279    (pushnew :sbcl-hooks-require *features*)))
1280
1281#+(and sbcl sbcl-hooks-require)
1282(progn
1283  (defun module-provide-asdf (name)
1284    (handler-bind ((style-warning #'muffle-warning))
1285      (let* ((*verbose-out* (make-broadcast-stream))
1286             (system (asdf:find-system name nil)))
1287        (when system
1288          (asdf:operate 'asdf:load-op name)
1289          t))))
1290
1291  (defun contrib-sysdef-search (system)
1292    (let ((home (sb-ext:posix-getenv "SBCL_HOME")))
1293      (when (and home (not (string= home "")))
1294        (let* ((name (coerce-name system))
1295               (home (truename home))
1296               (contrib (merge-pathnames
1297                         (make-pathname :directory `(:relative ,name)
1298                                        :name name
1299                                        :type "asd"
1300                                        :case :local
1301                                        :version :newest)
1302                         home)))
1303          (probe-file contrib)))))
1304
1305  (pushnew
1306   '(let ((home (sb-ext:posix-getenv "SBCL_HOME")))
1307      (when (and home (not (string= home "")))
1308        (merge-pathnames "site-systems/" (truename home))))
1309   *central-registry*)
1310
1311  (pushnew
1312   '(merge-pathnames ".sbcl/systems/"
1313     (user-homedir-pathname))
1314   *central-registry*)
1315
1316  (pushnew 'module-provide-asdf sb-ext:*module-provider-functions*)
1317  (pushnew 'contrib-sysdef-search *system-definition-search-functions*))
1318
1319(provide 'asdf)
Note: See TracBrowser for help on using the repository browser.