~ruther/guix-local

4209c31b8f5ad65f741be1baaf0747abb96c8a56 — Andy Patterson 9 years ago b9afcb9
build-system/asdf: Retain references to source files for binary outputs.

In support of long-running programs in which the users would like to be able
to jump to the source of a definition of any of the dependencies (itself
included) of the program.

* guix/build/asdf-build-system.scm (library-outputs): Move from here ...
* guix/build/lisp-utils.scm (library-outputs): ... to here.
(build-program): Accept dependency-prefixes argument, to allow the caller to
specify references which should be retained.  Default to the library's output.
(build-image): Likewise.
(generate-executable): Likewise.
* gnu/packages/lisp.scm (sbcl-stumpwm+slynk, sbcl-slynk, sbcl-stumpwm): Adjust
accordingly to the new interface.
(sbcl-stumpwm+slynk)[native-inputs]: Move to ...
[inputs]: ... here.
3 files changed, 47 insertions(+), 14 deletions(-)

M gnu/packages/lisp.scm
M guix/build/asdf-build-system.scm
M guix/build/lisp-utils.scm
M gnu/packages/lisp.scm => gnu/packages/lisp.scm +9 -4
@@ 904,6 904,7 @@ from other CLXes around the net.")
           (lambda* (#:key outputs #:allow-other-keys)
             (build-program
              (string-append (assoc-ref outputs "out") "/bin/stumpwm")
              outputs
              #:entry-program '((stumpwm:stumpwm) 0))))
         (add-after 'build-program 'create-desktop-file
           (lambda* (#:key outputs #:allow-other-keys)


@@ 1153,6 1154,7 @@ multiple inspectors with independent history.")
           (build-image (string-append
                         (assoc-ref %outputs "image")
                         "/bin/slynk")
                        %outputs
                        #:dependencies ',slynk-systems)))))))

(define-public ecl-slynk


@@ 1182,7 1184,7 @@ multiple inspectors with independent history.")
    (inherit sbcl-stumpwm)
    (name "sbcl-stumpwm-with-slynk")
    (outputs '("out"))
    (native-inputs
    (inputs
     `(("stumpwm" ,sbcl-stumpwm "lib")
       ("slynk" ,sbcl-slynk)))
    (arguments


@@ 1190,13 1192,16 @@ multiple inspectors with independent history.")
       ((#:phases phases)
        `(modify-phases ,phases
           (replace 'build-program
             (lambda* (#:key outputs #:allow-other-keys)
             (lambda* (#:key inputs outputs #:allow-other-keys)
               (let* ((out (assoc-ref outputs "out"))
                      (program (string-append out "/bin/stumpwm")))
                 (build-program program
                 (build-program program outputs
                                #:entry-program '((stumpwm:stumpwm) 0)
                                #:dependencies '("stumpwm"
                                                 ,@slynk-systems))
                                                 ,@slynk-systems)
                                #:dependency-prefixes
                                (map (lambda (input) (assoc-ref inputs input))
                                     '("stumpwm" "slynk")))
                 ;; Remove unneeded file.
                 (delete-file (string-append out "/bin/stumpwm-exec.fasl"))
                 #t)))

M guix/build/asdf-build-system.scm => guix/build/asdf-build-system.scm +0 -4
@@ 71,10 71,6 @@ to it's binary output."
(define (source-asd-file output name asd-file)
  (string-append (lisp-source-directory output name) "/" asd-file))

(define (library-output outputs)
  "If a `lib' output exists, build things there. Otherwise use `out'."
  (or (assoc-ref outputs "lib") (assoc-ref outputs "out")))

(define (copy-files-to-output out name)
  "Copy all files from the current directory to OUT.  Create an extra link to
any system-defining files in the source to a convenient location.  This is

M guix/build/lisp-utils.scm => guix/build/lisp-utils.scm +38 -6
@@ 42,7 42,8 @@
            build-image
            make-asd-file
            valid-char-set
            normalize-string))
            normalize-string
            library-output))

;;; Commentary:
;;;


@@ 67,6 68,10 @@
(define (%bundle-install-prefix)
  (string-append %source-install-prefix "/" (%lisp-type) "-bundle-systems"))

(define (library-output outputs)
  "If a `lib' output exists, build things there. Otherwise use `out'."
  (or (assoc-ref outputs "lib") (assoc-ref outputs "out")))

;; See nix/libstore/store-api.cc#checkStoreName.
(define valid-char-set
  (string->char-set


@@ 298,16 303,20 @@ which are not nested."
  (setenv "CL_SOURCE_REGISTRY"
          (string-append path ":" (or (getenv "CL_SOURCE_REGISTRY") ""))))

(define* (build-program program #:key
(define* (build-program program outputs #:key
                        (dependency-prefixes (list (library-output outputs)))
                        (dependencies (list (basename program)))
                        entry-program
                        #:allow-other-keys)
  "Generate an executable program containing all DEPENDENCIES, and which will
execute ENTRY-PROGRAM.  The result is placed in PROGRAM.  When executed, it
will run ENTRY-PROGRAM, a list of Common Lisp expressions in which `arguments'
has been bound to the command-line arguments which were passed."
has been bound to the command-line arguments which were passed.  Link in any
asd files from DEPENDENCY-PREFIXES to ensure references to those libraries are
retained."
  (generate-executable program
                       #:dependencies dependencies
                       #:dependency-prefixes dependency-prefixes
                       #:entry-program entry-program
                       #:type 'asdf:program-op)
  (let* ((name (basename program))


@@ 317,13 326,16 @@ has been bound to the command-line arguments which were passed."
                   name)))
  #t)

(define* (build-image image #:key
(define* (build-image image outputs #:key
                      (dependency-prefixes (list (library-output outputs)))
                      (dependencies (list (basename image)))
                      #:allow-other-keys)
  "Generate an image, possibly standalone, which contains all DEPENDENCIES,
placing the result in IMAGE.image."
placing the result in IMAGE.image.  Link in any asd files from
DEPENDENCY-PREFIXES to ensure references to those libraries are retained."
  (generate-executable image
                       #:dependencies dependencies
                       #:dependency-prefixes dependency-prefixes
                       #:entry-program '(nil)
                       #:type 'asdf:image-op)
  (let* ((name (basename image))


@@ 335,12 347,14 @@ placing the result in IMAGE.image."

(define* (generate-executable out-file #:key
                              dependencies
                              dependency-prefixes
                              entry-program
                              type
                              #:allow-other-keys)
  "Generate an executable by using asdf operation TYPE, containing whithin the
image all DEPENDENCIES, and running ENTRY-PROGRAM in the case of an
executable."
executable.  Link in any asd files from DEPENDENCY-PREFIXES to ensure
references to those libraries are retained."
  (let* ((bin-directory (dirname out-file))
         (name (basename out-file)))
    (mkdir-p bin-directory)


@@ 361,5 375,23 @@ executable."

    (generate-executable-for-system type name)

    (let* ((after-store-prefix-index
            (string-index out-file #\/
                          (1+ (string-length (%store-directory)))))
           (output (string-take out-file after-store-prefix-index))
           (hidden-asd-links (string-append output "/.asd-files")))

      (mkdir-p hidden-asd-links)
      (for-each
       (lambda (path)
         (for-each
          (lambda (asd-file)
            (symlink asd-file
                     (string-append hidden-asd-links
                                    "/" (basename asd-file))))
          (find-files (string-append path (%bundle-install-prefix))
                      "\\.asd$")))
       dependency-prefixes))

    (delete-file (string-append bin-directory "/" name "-exec.asd"))
    (delete-file (string-append bin-directory "/" name "-exec.lisp"))))