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:
		
							parent
							
								
									b9afcb9ed4
								
							
						
					
					
						commit
						4209c31b8f
					
				
					 3 changed files with 47 additions and 14 deletions
				
			
		| 
						 | 
					@ -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)))
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -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
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -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"))))
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue