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.
This commit is contained in:
Andy Patterson 2017-04-03 09:01:33 -04:00 committed by Ricardo Wurmus
parent b9afcb9ed4
commit 4209c31b8f
No known key found for this signature in database
GPG Key ID: 197A5888235FACAC
3 changed files with 47 additions and 14 deletions

View File

@ -904,6 +904,7 @@ from other CLXes around the net.")
(lambda* (#:key outputs #:allow-other-keys) (lambda* (#:key outputs #:allow-other-keys)
(build-program (build-program
(string-append (assoc-ref outputs "out") "/bin/stumpwm") (string-append (assoc-ref outputs "out") "/bin/stumpwm")
outputs
#:entry-program '((stumpwm:stumpwm) 0)))) #:entry-program '((stumpwm:stumpwm) 0))))
(add-after 'build-program 'create-desktop-file (add-after 'build-program 'create-desktop-file
(lambda* (#:key outputs #:allow-other-keys) (lambda* (#:key outputs #:allow-other-keys)
@ -1153,6 +1154,7 @@ multiple inspectors with independent history.")
(build-image (string-append (build-image (string-append
(assoc-ref %outputs "image") (assoc-ref %outputs "image")
"/bin/slynk") "/bin/slynk")
%outputs
#:dependencies ',slynk-systems))))))) #:dependencies ',slynk-systems)))))))
(define-public ecl-slynk (define-public ecl-slynk
@ -1182,7 +1184,7 @@ multiple inspectors with independent history.")
(inherit sbcl-stumpwm) (inherit sbcl-stumpwm)
(name "sbcl-stumpwm-with-slynk") (name "sbcl-stumpwm-with-slynk")
(outputs '("out")) (outputs '("out"))
(native-inputs (inputs
`(("stumpwm" ,sbcl-stumpwm "lib") `(("stumpwm" ,sbcl-stumpwm "lib")
("slynk" ,sbcl-slynk))) ("slynk" ,sbcl-slynk)))
(arguments (arguments
@ -1190,13 +1192,16 @@ multiple inspectors with independent history.")
((#:phases phases) ((#:phases phases)
`(modify-phases ,phases `(modify-phases ,phases
(replace 'build-program (replace 'build-program
(lambda* (#:key outputs #:allow-other-keys) (lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out")) (let* ((out (assoc-ref outputs "out"))
(program (string-append out "/bin/stumpwm"))) (program (string-append out "/bin/stumpwm")))
(build-program program (build-program program outputs
#:entry-program '((stumpwm:stumpwm) 0) #:entry-program '((stumpwm:stumpwm) 0)
#:dependencies '("stumpwm" #:dependencies '("stumpwm"
,@slynk-systems)) ,@slynk-systems)
#:dependency-prefixes
(map (lambda (input) (assoc-ref inputs input))
'("stumpwm" "slynk")))
;; Remove unneeded file. ;; Remove unneeded file.
(delete-file (string-append out "/bin/stumpwm-exec.fasl")) (delete-file (string-append out "/bin/stumpwm-exec.fasl"))
#t))) #t)))

View File

@ -71,10 +71,6 @@ to it's binary output."
(define (source-asd-file output name asd-file) (define (source-asd-file output name asd-file)
(string-append (lisp-source-directory 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) (define (copy-files-to-output out name)
"Copy all files from the current directory to OUT. Create an extra link to "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 any system-defining files in the source to a convenient location. This is

View File

@ -42,7 +42,8 @@
build-image build-image
make-asd-file make-asd-file
valid-char-set valid-char-set
normalize-string)) normalize-string
library-output))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -67,6 +68,10 @@
(define (%bundle-install-prefix) (define (%bundle-install-prefix)
(string-append %source-install-prefix "/" (%lisp-type) "-bundle-systems")) (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. ;; See nix/libstore/store-api.cc#checkStoreName.
(define valid-char-set (define valid-char-set
(string->char-set (string->char-set
@ -298,16 +303,20 @@ which are not nested."
(setenv "CL_SOURCE_REGISTRY" (setenv "CL_SOURCE_REGISTRY"
(string-append path ":" (or (getenv "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))) (dependencies (list (basename program)))
entry-program entry-program
#:allow-other-keys) #:allow-other-keys)
"Generate an executable program containing all DEPENDENCIES, and which will "Generate an executable program containing all DEPENDENCIES, and which will
execute ENTRY-PROGRAM. The result is placed in PROGRAM. When executed, it 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' 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 (generate-executable program
#:dependencies dependencies #:dependencies dependencies
#:dependency-prefixes dependency-prefixes
#:entry-program entry-program #:entry-program entry-program
#:type 'asdf:program-op) #:type 'asdf:program-op)
(let* ((name (basename program)) (let* ((name (basename program))
@ -317,13 +326,16 @@ has been bound to the command-line arguments which were passed."
name))) name)))
#t) #t)
(define* (build-image image #:key (define* (build-image image outputs #:key
(dependency-prefixes (list (library-output outputs)))
(dependencies (list (basename image))) (dependencies (list (basename image)))
#:allow-other-keys) #:allow-other-keys)
"Generate an image, possibly standalone, which contains all DEPENDENCIES, "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 (generate-executable image
#:dependencies dependencies #:dependencies dependencies
#:dependency-prefixes dependency-prefixes
#:entry-program '(nil) #:entry-program '(nil)
#:type 'asdf:image-op) #:type 'asdf:image-op)
(let* ((name (basename image)) (let* ((name (basename image))
@ -335,12 +347,14 @@ placing the result in IMAGE.image."
(define* (generate-executable out-file #:key (define* (generate-executable out-file #:key
dependencies dependencies
dependency-prefixes
entry-program entry-program
type type
#:allow-other-keys) #:allow-other-keys)
"Generate an executable by using asdf operation TYPE, containing whithin the "Generate an executable by using asdf operation TYPE, containing whithin the
image all DEPENDENCIES, and running ENTRY-PROGRAM in the case of an 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)) (let* ((bin-directory (dirname out-file))
(name (basename out-file))) (name (basename out-file)))
(mkdir-p bin-directory) (mkdir-p bin-directory)
@ -361,5 +375,23 @@ executable."
(generate-executable-for-system type name) (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.asd"))
(delete-file (string-append bin-directory "/" name "-exec.lisp")))) (delete-file (string-append bin-directory "/" name "-exec.lisp"))))