diff options
| -rw-r--r-- | gnu/packages/lisp.scm | 23 | ||||
| -rw-r--r-- | guix/build-system/asdf.scm | 33 | ||||
| -rw-r--r-- | guix/build/asdf-build-system.scm | 74 | ||||
| -rw-r--r-- | guix/build/lisp-utils.scm | 135 |
4 files changed, 128 insertions, 137 deletions
diff --git a/gnu/packages/lisp.scm b/gnu/packages/lisp.scm index aedb24587f..ed8a043583 100644 --- a/gnu/packages/lisp.scm +++ b/gnu/packages/lisp.scm @@ -856,11 +856,9 @@ from other CLXes around the net.") '(#:phases (modify-phases %standard-phases (add-after 'create-symlinks 'build-program - (lambda* (#:key lisp-type outputs inputs #:allow-other-keys) + (lambda* (#:key outputs #:allow-other-keys) (build-program - lisp-type (string-append (assoc-ref outputs "out") "/bin/stumpwm") - #:inputs inputs #:entry-program '((stumpwm:stumpwm) 0)))) (add-after 'build-program 'create-desktop-file (lambda* (#:key outputs #:allow-other-keys) @@ -1103,12 +1101,14 @@ multiple inspectors with independent history.") (prepend-to-source-registry (string-append (assoc-ref %outputs "out") "//")) - (build-image "sbcl" - (string-append - (assoc-ref %outputs "image") - "/bin/slynk") - #:inputs %build-inputs - #:dependencies ',slynk-systems)))))) + + (parameterize ((%lisp-type "sbcl") + (%lisp (string-append (assoc-ref %build-inputs "sbcl") + "/bin/sbcl"))) + (build-image (string-append + (assoc-ref %outputs "image") + "/bin/slynk") + #:dependencies ',slynk-systems))))))) (define-public ecl-slynk (package @@ -1145,11 +1145,10 @@ multiple inspectors with independent history.") ((#:phases phases) `(modify-phases ,phases (replace 'build-program - (lambda* (#:key lisp-type inputs outputs #:allow-other-keys) + (lambda* (#:key outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) (program (string-append out "/bin/stumpwm"))) - (build-program lisp-type program - #:inputs inputs + (build-program program #:entry-program '((stumpwm:stumpwm) 0) #:dependencies '("stumpwm" ,@slynk-systems)) diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm index 1ef6f32d4c..4afc6ef1a7 100644 --- a/guix/build-system/asdf.scm +++ b/guix/build-system/asdf.scm @@ -273,21 +273,24 @@ set up using CL source package conventions." (define builder `(begin (use-modules ,@modules) - (asdf-build #:name ,name - #:source ,(match (assoc-ref inputs "source") - (((? derivation? source)) - (derivation->output-path source)) - ((source) source) - (source source)) - #:lisp-type ,lisp-type - #:asd-file ,asd-file - #:system ,system - #:tests? ,tests? - #:phases ,phases - #:outputs %outputs - #:search-paths ',(map search-path-specification->sexp - search-paths) - #:inputs %build-inputs))) + (parameterize ((%lisp (string-append + (assoc-ref %build-inputs ,lisp-type) + "/bin/" ,lisp-type)) + (%lisp-type ,lisp-type)) + (asdf-build #:name ,name + #:source ,(match (assoc-ref inputs "source") + (((? derivation? source)) + (derivation->output-path source)) + ((source) source) + (source source)) + #:asd-file ,asd-file + #:system ,system + #:tests? ,tests? + #:phases ,phases + #:outputs %outputs + #:search-paths ',(map search-path-specification->sexp + search-paths) + #:inputs %build-inputs)))) (define guile-for-build (match guile diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm index c5f2c080dc..4305a86af9 100644 --- a/guix/build/asdf-build-system.scm +++ b/guix/build/asdf-build-system.scm @@ -43,8 +43,8 @@ (define %object-prefix "/lib") -(define (source-install-prefix lisp) - (string-append %source-install-prefix "/" lisp "-source")) +(define (%lisp-source-install-prefix) + (string-append %source-install-prefix "/" (%lisp-type) "-source")) (define %system-install-prefix (string-append %source-install-prefix "/systems")) @@ -56,28 +56,27 @@ (output-path->package-name (assoc-ref outputs "out"))) -(define (lisp-source-directory output lisp name) - (string-append output (source-install-prefix lisp) "/" name)) +(define (lisp-source-directory output name) + (string-append output (%lisp-source-install-prefix) "/" name)) (define (source-directory output name) (string-append output %source-install-prefix "/source/" name)) -(define (library-directory output lisp) +(define (library-directory output) (string-append output %object-prefix - "/" lisp)) + "/" (%lisp-type))) (define (output-translation source-path - object-output - lisp) + object-output) "Return a translation for the system's source path to it's binary output." `((,source-path :**/ :*.*.*) - (,(library-directory object-output lisp) + (,(library-directory object-output) :**/ :*.*.*))) -(define (source-asd-file output lisp name asd-file) - (string-append (lisp-source-directory output lisp name) "/" asd-file)) +(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'." @@ -104,32 +103,29 @@ valid." "Copy and symlink all the source files." (copy-files-to-output (assoc-ref outputs "out") (outputs->name outputs))) -(define* (copy-source #:key outputs lisp-type #:allow-other-keys) +(define* (copy-source #:key outputs #:allow-other-keys) "Copy the source to the library output." (let* ((out (library-output outputs)) - (name (remove-lisp-from-name (output-path->package-name out) - lisp-type)) + (name (remove-lisp-from-name (output-path->package-name out))) (install-path (string-append out %source-install-prefix))) (copy-files-to-output out name) ;; Hide the files from asdf (with-directory-excursion install-path - (rename-file "source" (string-append lisp-type "-source")) + (rename-file "source" (string-append (%lisp-type) "-source")) (delete-file-recursively "systems"))) #t) -(define* (build #:key outputs inputs lisp-type asd-file +(define* (build #:key outputs inputs asd-file #:allow-other-keys) "Compile the system." (let* ((out (library-output outputs)) - (name (remove-lisp-from-name (output-path->package-name out) - lisp-type)) - (source-path (lisp-source-directory out lisp-type name)) + (name (remove-lisp-from-name (output-path->package-name out))) + (source-path (lisp-source-directory out name)) (translations (wrap-output-translations `(,(output-translation source-path - out - lisp-type)))) + out)))) (asd-file (and=> asd-file - (cut source-asd-file out lisp-type name <>)))) + (cut source-asd-file out name <>)))) (setenv "ASDF_OUTPUT_TRANSLATIONS" (replace-escaped-macros (format #f "~S" translations))) @@ -141,9 +137,7 @@ valid." (setenv "HOME" out) ; ecl's asdf sometimes wants to create $HOME/.cache - (parameterize ((%lisp (string-append - (assoc-ref inputs lisp-type) "/bin/" lisp-type))) - (compile-system name lisp-type asd-file)) + (compile-system name asd-file) ;; As above, ecl will sometimes create this even though it doesn't use it @@ -152,48 +146,44 @@ valid." (delete-file-recursively cache-directory)))) #t) -(define* (check #:key lisp-type tests? outputs inputs asd-file +(define* (check #:key tests? outputs inputs asd-file #:allow-other-keys) "Test the system." - (let* ((name (remove-lisp-from-name (outputs->name outputs) lisp-type)) + (let* ((name (remove-lisp-from-name (outputs->name outputs))) (out (library-output outputs)) (asd-file (and=> asd-file - (cut source-asd-file out lisp-type name <>)))) + (cut source-asd-file out name <>)))) (if tests? - (parameterize ((%lisp (string-append - (assoc-ref inputs lisp-type) "/bin/" lisp-type))) - (test-system name lisp-type asd-file)) + (test-system name asd-file) (format #t "test suite not run~%"))) #t) (define* (create-asd-file #:key outputs inputs - lisp-type asd-file #:allow-other-keys) "Create a system definition file for the built system." (let*-values (((out) (library-output outputs)) ((full-name version) (package-name->name+version (strip-store-file-name out))) - ((name) (remove-lisp-from-name full-name lisp-type)) - ((new-asd-file) (string-append (library-directory out lisp-type) + ((name) (remove-lisp-from-name full-name)) + ((new-asd-file) (string-append (library-directory out) "/" name ".asd"))) (make-asd-file new-asd-file - #:lisp lisp-type #:system name #:version version #:inputs inputs #:system-asd-file asd-file)) #t) -(define* (symlink-asd-files #:key outputs lisp-type #:allow-other-keys) +(define* (symlink-asd-files #:key outputs #:allow-other-keys) "Create an extra reference to the system in a convenient location." (let* ((out (library-output outputs))) (for-each (lambda (asd-file) (receive (new-asd-file asd-file-directory) - (bundle-asd-file out asd-file lisp-type) + (bundle-asd-file out asd-file) (mkdir-p asd-file-directory) (symlink asd-file new-asd-file) ;; Update the source registry for future phases which might want to @@ -204,11 +194,11 @@ valid." (find-files (string-append out %object-prefix) "\\.asd$"))) #t) -(define* (cleanup-files #:key outputs lisp-type +(define* (cleanup-files #:key outputs #:allow-other-keys) "Remove any compiled files which are not a part of the final bundle." (let ((out (library-output outputs))) - (match lisp-type + (match (%lisp-type) ("sbcl" (for-each (lambda (file) @@ -220,7 +210,7 @@ valid." (append (find-files out "\\.fas$") (find-files out "\\.o$"))))) - (with-directory-excursion (library-directory out lisp-type) + (with-directory-excursion (library-directory out) (for-each (lambda (file) (rename-file file @@ -235,9 +225,9 @@ valid." (string<> ".." file))))))) #t) -(define* (strip #:key lisp-type #:allow-other-keys #:rest args) +(define* (strip #:rest args) ;; stripping sbcl binaries removes their entry program and extra systems - (or (string=? lisp-type "sbcl") + (or (string=? (%lisp-type) "sbcl") (apply (assoc-ref gnu:%standard-phases 'strip) args))) (define %standard-phases/source diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm index 4f1565b55c..148357bf0e 100644 --- a/guix/build/lisp-utils.scm +++ b/guix/build/lisp-utils.scm @@ -25,6 +25,7 @@ #:use-module (srfi srfi-26) #:use-module (guix build utils) #:export (%lisp + %lisp-type %source-install-prefix lisp-eval-program compile-system @@ -33,7 +34,7 @@ generate-executable-wrapper-system generate-executable-entry-point generate-executable-for-system - bundle-install-prefix + %bundle-install-prefix bundle-asd-file remove-lisp-from-name wrap-output-translations @@ -54,24 +55,28 @@ ;; File name of the Lisp compiler. (make-parameter "lisp")) +(define %lisp-type + ;; String representing the class of implementation being used. + (make-parameter "lisp")) + ;; The common parent for Lisp source files, as will as the symbolic ;; link farm for system definition (.asd) files. (define %source-install-prefix "/share/common-lisp") -(define (bundle-install-prefix lisp) - (string-append %source-install-prefix "/" lisp "-bundle-systems")) +(define (%bundle-install-prefix) + (string-append %source-install-prefix "/" (%lisp-type) "-bundle-systems")) (define (remove-lisp-from-name name lisp) (string-drop name (1+ (string-length lisp)))) -(define (inputs->asd-file-map inputs lisp) +(define (inputs->asd-file-map inputs) "Produce a hash table of the form (system . asd-file), where system is the name of an ASD system, and asd-file is the full path to its definition." (alist->hash-table (filter-map (match-lambda ((_ . path) - (let ((prefix (string-append path (bundle-install-prefix lisp)))) + (let ((prefix (string-append path (%bundle-install-prefix)))) (and (directory-exists? prefix) (match (find-files prefix "\\.asd$") ((asd-file) @@ -86,16 +91,16 @@ name of an ASD system, and asd-file is the full path to its definition." ,@translations :inherit-configuration)) -(define (lisp-eval-program lisp program) +(define (lisp-eval-program program) "Evaluate PROGRAM with a given LISP implementation." (unless (zero? (apply system* - (lisp-invoke lisp (format #f "~S" program)))) - (error "lisp-eval-program failed!" lisp program))) + (lisp-invoke (format #f "~S" program)))) + (error "lisp-eval-program failed!" (%lisp) program))) -(define (lisp-invoke lisp program) +(define (lisp-invoke program) "Return a list of arguments for system* determining how to invoke LISP with PROGRAM." - (match lisp + (match (%lisp-type) ("sbcl" `(,(%lisp) "--non-interactive" "--eval" ,program)) ("ecl" `(,(%lisp) "-eval" ,program "-eval" "(quit)")) (_ (error "The LISP provided is not supported at this time.")))) @@ -109,26 +114,26 @@ with PROGRAM." ,system)) systems)) -(define (compile-system system lisp asd-file) +(define (compile-system system asd-file) "Use a lisp implementation to compile SYSTEM using asdf. Load ASD-FILE first if SYSTEM is defined there." - (lisp-eval-program lisp - `(progn - (require :asdf) - (in-package :asdf) - ,@(if asd-file - `((load ,asd-file)) - '()) - (in-package :cl-user) - (funcall (find-symbol - (symbol-name :operate) - (symbol-name :asdf)) - (find-symbol - (symbol-name :compile-bundle-op) - (symbol-name :asdf)) - ,system)))) - -(define (system-dependencies lisp system asd-file) + (lisp-eval-program + `(progn + (require :asdf) + (in-package :asdf) + ,@(if asd-file + `((load ,asd-file)) + '()) + (in-package :cl-user) + (funcall (find-symbol + (symbol-name :operate) + (symbol-name :asdf)) + (find-symbol + (symbol-name :compile-bundle-op) + (symbol-name :asdf)) + ,system)))) + +(define (system-dependencies system asd-file) "Return the dependencies of SYSTEM, as reported by asdf:system-depends-on. First load the system's ASD-FILE, if necessary." (define deps-file ".deps.sexp") @@ -157,56 +162,55 @@ asdf:system-depends-on. First load the system's ASD-FILE, if necessary." (dynamic-wind (lambda _ - (lisp-eval-program lisp program)) + (lisp-eval-program program)) (lambda _ (call-with-input-file deps-file read)) (lambda _ (when (file-exists? deps-file) (delete-file deps-file))))) -(define (compiled-system system lisp) - (match lisp +(define (compiled-system system) + (match (%lisp-type) ("sbcl" (string-append system "--system")) (_ system))) -(define* (generate-system-definition lisp system +(define* (generate-system-definition system #:key version dependencies) `(asdf:defsystem ,system :class asdf/bundle:prebuilt-system :version ,version :depends-on ,dependencies - :components ((:compiled-file ,(compiled-system system lisp))) - ,@(if (string=? "ecl" lisp) + :components ((:compiled-file ,(compiled-system system))) + ,@(if (string=? "ecl" (%lisp-type)) `(:lib ,(string-append system ".a")) '()))) -(define (test-system system lisp asd-file) +(define (test-system system asd-file) "Use a lisp implementation to test SYSTEM using asdf. Load ASD-FILE first if SYSTEM is defined there." - (lisp-eval-program lisp - `(progn - (require :asdf) - (in-package :asdf) - ,@(if asd-file - `((load ,asd-file)) - '()) - (in-package :cl-user) - (funcall (find-symbol - (symbol-name :test-system) - (symbol-name :asdf)) - ,system)))) + (lisp-eval-program + `(progn + (require :asdf) + (in-package :asdf) + ,@(if asd-file + `((load ,asd-file)) + '()) + (in-package :cl-user) + (funcall (find-symbol + (symbol-name :test-system) + (symbol-name :asdf)) + ,system)))) (define (string->lisp-keyword . strings) "Return a lisp keyword for the concatenation of STRINGS." (string->symbol (apply string-append ":" strings))) -(define (generate-executable-for-system type system lisp) +(define (generate-executable-for-system type system) "Use LISP to generate an executable, whose TYPE can be \"image\" or \"program\". The latter will always be standalone. Depends on having created a \"SYSTEM-exec\" system which contains the entry program." (lisp-eval-program - lisp `(progn (require :asdf) (funcall (find-symbol @@ -249,7 +253,7 @@ ENTRY-PROGRAM for SYSTEM within the current directory." (declare (ignorable arguments)) ,@entry-program)))))))) -(define (generate-dependency-links lisp registry system) +(define (generate-dependency-links registry system) "Creates a program which populates asdf's source registry from REGISTRY, an alist of dependency names to corresponding asd files. This allows the system to locate its dependent systems." @@ -265,16 +269,15 @@ to locate its dependent systems." registry))) (define* (make-asd-file asd-file - #:key lisp system version inputs + #:key system version inputs (system-asd-file #f)) "Create an ASD-FILE for SYSTEM@VERSION, appending a program to allow the system to find its dependencies, as described by GENERATE-DEPENDENCY-LINKS." (define dependencies - (parameterize ((%lisp (string-append (assoc-ref inputs lisp) "/bin/" lisp))) - (system-dependencies lisp system system-asd-file))) + (system-dependencies system system-asd-file)) (define lisp-input-map - (inputs->asd-file-map inputs lisp)) + (inputs->asd-file-map inputs)) (define registry (filter-map hash-get-handle @@ -291,18 +294,18 @@ system to find its dependencies, as described by GENERATE-DEPENDENCY-LINKS." (display (replace-escaped-macros (format #f "~y~%~y~%" - (generate-system-definition lisp system + (generate-system-definition system #:version version #:dependencies dependencies) - (generate-dependency-links lisp registry system))) + (generate-dependency-links registry system))) port)))) -(define (bundle-asd-file output-path original-asd-file lisp) +(define (bundle-asd-file output-path original-asd-file) "Find the symlinked bundle file for ORIGINAL-ASD-FILE by looking in OUTPUT-PATH/share/common-lisp/LISP-bundle-systems/<system>.asd. Returns two values: the asd file itself and the directory in which it resides." (let ((bundle-asd-path (string-append output-path - (bundle-install-prefix lisp)))) + (%bundle-install-prefix)))) (values (string-append bundle-asd-path "/" (basename original-asd-file)) bundle-asd-path))) @@ -317,7 +320,7 @@ which are not nested." (setenv "CL_SOURCE_REGISTRY" (string-append path ":" (or (getenv "CL_SOURCE_REGISTRY") "")))) -(define* (build-program lisp program #:key inputs +(define* (build-program program #:key (dependencies (list (basename program))) entry-program #:allow-other-keys) @@ -325,8 +328,7 @@ which are not nested." 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." - (generate-executable lisp program - #:inputs inputs + (generate-executable program #:dependencies dependencies #:entry-program entry-program #:type "program") @@ -337,13 +339,12 @@ has been bound to the command-line arguments which were passed." name))) #t) -(define* (build-image lisp image #:key inputs +(define* (build-image image #:key (dependencies (list (basename image))) #:allow-other-keys) "Generate an image, possibly standalone, which contains all DEPENDENCIES, placing the result in IMAGE.image." - (generate-executable lisp image - #:inputs inputs + (generate-executable image #:dependencies dependencies #:entry-program '(nil) #:type "image") @@ -354,7 +355,7 @@ placing the result in IMAGE.image." (string-append name ".image")))) #t) -(define* (generate-executable lisp out-file #:key inputs +(define* (generate-executable out-file #:key dependencies entry-program type @@ -380,9 +381,7 @@ executable." `(((,bin-directory :**/ :*.*.*) (,bin-directory :**/ :*.*.*))))))) - (parameterize ((%lisp (string-append - (assoc-ref inputs lisp) "/bin/" lisp))) - (generate-executable-for-system type name lisp)) + (generate-executable-for-system type name) (delete-file (string-append bin-directory "/" name "-exec.asd")) (delete-file (string-append bin-directory "/" name "-exec.lisp")))) |