Remove a few asdf: prefixes.
authorFrancois-Rene Rideau <tunes@google.com>
Thu, 3 Jan 2013 16:19:42 +0000 (11:19 -0500)
committerFrancois-Rene Rideau <tunes@google.com>
Thu, 3 Jan 2013 16:19:42 +0000 (11:19 -0500)
asdf-ops.lisp

index 6ab907b..fd8f905 100644 (file)
@@ -2,7 +2,7 @@
 
 (cl:in-package #:asdf-dependency-grovel)
 
-(defmethod asdf:output-files :around ((op asdf:compile-op) (comp instrumented-cl-source-file))
+(defmethod output-files :around ((op compile-op) (comp instrumented-cl-source-file))
   "Put instrumented FASL files in a temporary directory relative
 to the base of the system."
   (let* ((output-file (car (call-next-method)))
@@ -30,7 +30,6 @@ to the base of the system."
 (defun call-with-dependency-tracking (comp thunk)
   (if *current-constituent*
       (operating-on-asdf-component-constituent (comp)
-        ;((merge-pathnames (asdf:component-pathname comp)))
         (with-groveling-readtable
           (with-groveling-macroexpand-hook
             (funcall thunk))))
@@ -38,7 +37,7 @@ to the base of the system."
 ;;       (if *current-dependency-state*
 ;;           (operating-on-component (comp)
 ;;             (let ((file (namestring (merge-pathnames
-;;                                      (asdf:component-pathname comp))))
+;;                                      (component-pathname comp))))
 ;;                   (*readtable* (make-instrumented-readtable)))
 ;;               (signal-user file 'file-component)
 ;;               (noticing-*feature*-changes
@@ -53,38 +52,38 @@ to the base of the system."
 
 #|
 (macrolet ((emit-perform-method (op-type)
-             `(defmethod asdf:perform :around
+             `(defmethod perform :around
                   ((op ,op-type)
                    (comp instrumented-cl-source-file))
                 (with-dependency-tracking comp (call-next-method)))))
-  (emit-perform-method asdf:load-source-op)
-  (emit-perform-method asdf:load-op)
-  (emit-perform-method asdf:compile-op))
+  (emit-perform-method load-source-op)
+  (emit-perform-method load-op)
+  (emit-perform-method compile-op))
 |#
 
-(defmethod asdf:perform
-    ((op asdf:load-source-op)
+(defmethod perform
+    ((op load-source-op)
      (comp instrumented-cl-source-file))
-  (wtf "Perform asdf:load-source-op ~S" comp)
-  (let ((source (asdf:component-pathname comp)))
+  (wtf "Perform load-source-op ~S" comp)
+  (let ((source (component-pathname comp)))
     ;; do NOT grovel the same file more than once
     (operating-on-asdf-component-constituent (comp)
-      (unless (asdf:component-property comp 'last-loaded-as-source)
-        (setf (asdf:component-property comp 'last-loaded-as-source)
+      (unless (component-property comp 'last-loaded-as-source)
+        (setf (component-property comp 'last-loaded-as-source)
               (and (#+sbcl fine-grain-instrumented-load ;;load
                     #-sbcl instrumented-load
                     source)
                    (get-universal-time)))))))
 
-(defmethod asdf:perform :around
-    ((op asdf:compile-op)
+(defmethod perform :around
+    ((op compile-op)
      (comp instrumented-cl-source-file))
   nil)
 
-(defmethod asdf:perform :around
-    ((op asdf:load-op)
+(defmethod perform :around
+    ((op load-op)
      (comp instrumented-cl-source-file))
-  (asdf:perform (make-instance 'asdf:load-source-op) comp))
+  (perform (make-instance 'load-source-op) comp))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -93,7 +92,7 @@ to the base of the system."
 ;;; * ignore component-name. I have no idea what it /should/ indicate.
 
 ;; Used by XCVB:
-(defclass component-file (asdf:source-file)
+(defclass component-file (source-file)
   ((last-grovel-state :initform nil)
    (load-system :initarg :load-systems)
    (merge-systems :initarg :merge-systems)
@@ -113,7 +112,7 @@ to the base of the system."
       (:foo-system (\"component2\") :data-files ())"))))
 
 ;; Used by XCVB.
-(defclass dependency-op (asdf:operation) ())
+(defclass dependency-op (operation) ())
 
 (defun state-of (op component)
   (declare (ignore op))
@@ -123,50 +122,50 @@ to the base of the system."
   (declare (ignore op))
   (setf (slot-value component 'last-grovel-state) new-val))
 
-(defmethod asdf:source-file-type ((c component-file) (s asdf:module))
+(defmethod source-file-type ((c component-file) (s module))
   "asd")
 
-(defmethod asdf:output-files ((op dependency-op) (c component-file))
+(defmethod output-files ((op dependency-op) (c component-file))
   (list
    ;; XXX: base-pathname?
    (merge-pathnames (slot-value c 'output-file)
-                    (asdf:component-pathname c))))
+                    (component-pathname c))))
 
-(defmethod asdf:input-files ((op dependency-op) (c component-file))
+(defmethod input-files ((op dependency-op) (c component-file))
   ;; XXX: base-pathname?
-  (list (asdf:component-pathname c)))
+  (list (component-pathname c)))
 
-(defmethod asdf:operation-done-p ((op dependency-op) (comp component-file))
+(defmethod operation-done-p ((op dependency-op) (comp component-file))
   nil)
 
-(defvar *default-component-class* (find-class 'asdf:cl-source-file))
+(defvar *default-component-class* (find-class 'cl-source-file))
 
 ;;; XXX: nasty hack.
 ;;; Necessary to support asd files that weren't rewritten to use
 ;;; instrumented-module/instrumented-cl-source-file classes.
-(defmethod asdf::module-default-component-class :around ((c asdf:module))
+(defmethod :module-default-component-class :around ((c module))
   (let ((what-would-asdf-do (call-next-method)))
-    (if (member what-would-asdf-do `(nil asdf:cl-source-file
-                                         ,(find-class 'asdf:cl-source-file)))
+    (if (member what-would-asdf-do `(nil cl-source-file
+                                         ,(find-class 'cl-source-file)))
         *default-component-class*
         what-would-asdf-do)))
 
-;; Used by asdf:perform.
+;; Used by perform.
 (defun load-instrumented-systems (systems additional-initargs)
   (let ((*default-component-class* (find-class 'instrumented-cl-source-file)))
     (flet ((reload-system (system)
-             (let ((system (asdf:find-system system)))
-               (load (asdf:system-definition-pathname system)))))
+             (let ((system (find-system system)))
+               (load (system-definition-pathname system)))))
       (mapc #'reload-system systems)))
   (labels ((find-component-in-module (module components)
              (if (null (rest components))
-                 (asdf:find-component module (first components))
-                 (find-component-in-module (asdf:find-component
+                 (find-component module (first components))
+                 (find-component-in-module (find-component
                                             module (first components))
                                            (rest components))))
            (add-initargs (system compspec args)
              (let ((component (find-component-in-module
-                               (asdf:find-system system)
+                               (find-system system)
                                compspec)))
                (assert component (component)
                        "Component spec ~S in ~S didn't find a component."
@@ -181,8 +180,8 @@ to the base of the system."
                systems to merge." system)
       (add-initargs system compspec initargs))))
 
-(defmethod asdf:perform ((op dependency-op) (c component-file))
-  (let* ((destination-file (first (asdf:output-files op c)))
+(defmethod perform ((op dependency-op) (c component-file))
+  (let* ((destination-file (first (output-files op c)))
          (tmp-file-name (format nil "~A-~A"
                                  destination-file
                                  (get-universal-time))))
@@ -201,29 +200,29 @@ to the base of the system."
                     (truename (make-pathname :name nil
                                              :type nil
                                              :defaults
-                                             (asdf:component-pathname c))))))
+                                             (component-pathname c))))))
            (load-instrumented-systems merge-systems additional-initargs)
            (setf (state-of op c)
                  (if (state-of op c)
                      (error "I refuse to re-grovel.")
 ;;                      (re-grovel-dependencies
-;;                       (mapcar #'asdf:find-system
+;;                       (mapcar #'find-system
 ;;                               (if (consp load-system)
 ;;                                   load-system
 ;;                                   (list load-system)))
 ;;                       component-stream
-;;                       (mapcar #'asdf:find-system merge-systems)
+;;                       (mapcar #'find-system merge-systems)
 ;;                       (state-of op c)
 ;;                       :verbose verbose
 ;;                       :debug-object-types debug-object-types
 ;;                       :base-pathname base-pathname)
                      (initially-grovel-dependencies
-                      (mapcar #'asdf:find-system
+                      (mapcar #'find-system
                               (if (consp load-system)
                                   load-system
                                   (list load-system)))
                       component-stream
-                      (mapcar #'asdf:find-system merge-systems)
+                      (mapcar #'find-system merge-systems)
                       :verbose verbose
 ;;                      :cull-redundant cull-redundant
 ;;                      :debug-object-types debug-object-types
@@ -274,15 +273,15 @@ to the base of the system."
 ;; (defclass compare-dependency-op (dependency-op) ())
 
 ;; ;; Unused.
-;; (defmethod asdf:input-files ((op compare-dependency-op) (c component-file))
+;; (defmethod input-files ((op compare-dependency-op) (c component-file))
 ;;   (append (call-next-method) (list (slot-value c 'base-asd-file))))
 
 ;; ;; Unused.
-;; (defmethod asdf:output-files ((op compare-dependency-op) (c component-file))
+;; (defmethod output-files ((op compare-dependency-op) (c component-file))
 ;;   (append (call-next-method) (list (slot-value c 'output-file))))
 
 ;; ;; Unused.
-;; (defmethod asdf:perform ((op compare-dependency-op) (c component-file))
+;; (defmethod perform ((op compare-dependency-op) (c component-file))
 ;;   ;; not incremental yet (but it's mostly useless anyway for large systems?)
 ;;   (with-slots (load-system merge-systems base-asd-file output-file
 ;;                component-name-translation cull-redundant verbose
@@ -293,19 +292,19 @@ to the base of the system."
 ;;                                (make-pathname :name nil
 ;;                                               :type nil
 ;;                                               :defaults
-;;                                               (asdf:component-pathname c)))))
-;;            (out-pathname (pathname (first (asdf:output-files op c))))
+;;                                               (component-pathname c)))))
+;;            (out-pathname (pathname (first (output-files op c))))
 ;;            (tmp-pathname (make-pathname
 ;;                            :name (format nil "~A-~A" (pathname-name out-pathname) (get-universal-time))
 ;;                            :defaults out-pathname)))
 ;;        (load-instrumented-systems merge-systems additional-initargs)
 ;;        (prog1
-;;            (grovel-and-compare-dependencies (mapcar #'asdf:find-system
+;;            (grovel-and-compare-dependencies (mapcar #'find-system
 ;;                                                     (if (consp load-system)
 ;;                                                       load-system
 ;;                                                       (list load-system)))
 ;;                                             base-asd-file
-;;                                             (mapcar #'asdf:find-system merge-systems)
+;;                                             (mapcar #'find-system merge-systems)
 ;;                                             :output tmp-pathname
 ;;                                             :verbose verbose
 ;;                                             :cull-redundant cull-redundant