Changeset 13347


Ignore:
Timestamp:
06/18/11 06:39:58 (10 years ago)
Author:
Mark Evenson
Message:

ASDF-JAR:PACKAGE will compile and package asdf systems into jar files.

In order to load the fasls from these files, one has to disable ASDF's
output translations so that it searches the jar archive.

The packaing of recursive dependencies currently doesn't work.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/contrib/asdf-jar/asdf-jar.lisp

    r13346 r13347  
    1111(defun package (system-name
    1212                &key (out #p"/var/tmp/")
    13                      (recursive t)
     13                     (recursive t)          ; whether to package dependencies
     14                     (force t)              ; whether to force ASDF compilation
    1415                     (verbose t))
     16"Compile and package the asdf SYSTEM-NAME in a jar.
     17
     18Place the resulting packaging in the OUT directory."
    1519  (let* ((system
    1620          (asdf:find-system system-name))
     
    2024          (slot-value system 'asdf:version))
    2125         (package-jar-name
    22           (format nil "~A~A-~A.jar" name (when recursive "-all") version))
     26          (format nil "~A~A-~A.jar" name (if recursive "-all" "") version))
    2327         (package-jar
    2428          (make-pathname :directory (pathname-directory out) :defaults package-jar-name))
    2529         (mapping (make-hash-table :test 'equal)))
    2630    (when verbose
    27       (format verbose "~&Packaging ASDF definition of ~A~&as ~A." system package-jar))
     31      (format verbose "~&Packaging ASDF definition of ~A~&  as ~A." system package-jar))
    2832    (setf *systems* nil)
    2933    (when verbose
    3034      (format verbose "~&Forcing recursive compilation of ~A." package-jar))
    31     (asdf:compile-system system :force t)
     35    (asdf:compile-system system :force force)
    3236    (when verbose
    3337      (format verbose "~&Packaging contents in ~A." package-jar))
     
    3741            (asdf (slot-value system 'asdf::source-file)))
    3842        (setf (gethash asdf mapping) (relative-path base name asdf))
    39        
    40           ;;; XXX iterate through the rest of the contents of the
    41           ;;; system, adding appropiate entries
    4243        (let ((sources
    4344               (mapwalk system
     
    4546                        (lambda (c) (slot-value c 'asdf::absolute-pathname)))))
    4647          (loop :for source :in sources
    47              :for source-entry = (relative-pathname base source)
     48             :for source-entry = (relative-path base name source)
    4849             :for output = (make-pathname
    4950                             :defaults (asdf:apply-output-translations source)
    5051                             :type "abcl")
    51              :for output-entry = (relative-pathname base output)
     52             :for output-entry = (make-pathname
     53                                  :defaults source-entry
     54                                  :type "abcl")
    5255             :do (setf (gethash (namestring source) mapping)
    5356                       source-entry)
     
    5659      (system:zip package-jar mapping)))
    5760
    58 (defun relative-pathname (base source)
    59   (declare (ignore base source))
    60   (error "unimplemented."))
    61 
    6261;;; This more Map than Walk at this point ...
    6362(defun mapwalk (system test-if callable)
     63  "Apply CALLABLE to all components of asdf SYSTEM which satisfy TEST-IF.
     64
     65Both CALLABLE and TEST-IF are functions taking an asdf:component as their argument."
    6466  (declare (type system asdf:system))
    6567  (loop
     
    101103
    102104
     105
    103106   
    104107 
Note: See TracChangeset for help on using the changeset viewer.