···11-Prerequisite: have Quicklisp installed somehow.
11+Want to add a package? There are 3 simple steps!
22+1. Add the needed system names to quicklisp-to-nix-systems.txt.
33+2. cd <path to quicklisp-to-nix-systems.txt> ; nix-shell --run 'quicklisp-to-nix .'
44+3. Add native libraries and whatever else is needed to quicklisp-to-nix-overrides.nix.
2533-Add to LD_LIBRARY_PATH all the things listed in quicklisp-to-nix-overrides.nix
44-for library propagatedBuildInputs (a lot of these are done via addNativeLibs).
66+To update to a more recent quicklisp dist modify
77+lispPackages.quicklisp to have a more recent distinfo.
5866-Current list is:
77-openssl fuse libuv mariadb libfixposix libev sqlite
99+quicklisp-to-nix-system-info is responsible for installing a quicklisp
1010+package into an isolated environment and figuring out which packages
1111+are required by that system. It also extracts other information that
1212+is readily available once the system is loaded. The information
1313+produced by this program is fed into quicklisp-to-nix. You usually
1414+don't need to run this program unless you're trying to understand why
1515+quicklisp-to-nix failed to handle a system. The technique used by
1616+quicklisp-to-nix-system-info is described in its source.
81799-Add the needed system names to quicklisp-to-nix-systems.txt and load
1010-quicklisp-to-nix/ql-to-nix.lisp and call
1111-(ql-to-nix "/path/to/nixpkgs/pkgs/development/lisp-modules/") which is often
1212-just (ql-to-nix ".")
1313-1414-Add native libraries and whatever else is needed to overrides.
1515-1616-The lispPackages set is supposed to be buildable in its entirety.
1818+quicklisp-to-nix is responsible for reading
1919+quicklisp-to-nix-systems.txt, running quicklisp-to-nix-system-info,
2020+and generating the nix packages associated with the closure of
2121+quicklisp systems.
···11+(unless (find-package :ql-to-nix-util)
22+ (load "ql-to-nix-util.lisp"))
33+(defpackage :ql-to-nix-quicklisp-bootstrap
44+ (:use :common-lisp :ql-to-nix-util)
55+ (:export #:with-quicklisp)
66+ (:documentation
77+ "This package provides a way to create a temporary quicklisp installation."))
88+(in-package :ql-to-nix-quicklisp-bootstrap)
99+1010+(declaim (optimize (debug 3) (speed 0) (space 0) (compilation-speed 0) (safety 3)))
1111+1212+;; This file cannot have any dependencies beyond quicklisp and asdf.
1313+;; Otherwise, we'll miss some dependencies!
1414+1515+(defvar *quicklisp*
1616+ (namestring (pathname-as-directory (uiop:getenv "quicklisp")))
1717+ "The path to the nix quicklisp package.")
1818+1919+(defun prepare-quicklisp-dir (target-dir quicklisp-prototype-dir)
2020+ "Install quicklisp into the specified `target-dir'.
2121+2222+`quicklisp-prototype-dir' should be the path to the quicklisp nix
2323+package."
2424+ (ensure-directories-exist target-dir)
2525+ (dolist (subdir '(#P"dists/quicklisp/" #P"tmp/" #P"local-projects/" #P"quicklisp/"))
2626+ (ensure-directories-exist (merge-pathnames subdir target-dir)))
2727+ (with-open-file (s (merge-pathnames #P"dists/quicklisp/enabled.txt" target-dir) :direction :output :if-exists :supersede)
2828+ (format s "1~%"))
2929+ (uiop:copy-file
3030+ (merge-pathnames #P"lib/common-lisp/quicklisp/quicklisp-distinfo.txt" quicklisp-prototype-dir)
3131+ (merge-pathnames #P"dists/quicklisp/distinfo.txt" target-dir))
3232+ (uiop:copy-file
3333+ (merge-pathnames #P"lib/common-lisp/quicklisp/asdf.lisp" quicklisp-prototype-dir)
3434+ (merge-pathnames #P"asdf.lisp" target-dir))
3535+ (uiop:copy-file
3636+ (merge-pathnames #P"lib/common-lisp/quicklisp/setup.lisp" quicklisp-prototype-dir)
3737+ (merge-pathnames #P"setup.lisp" target-dir))
3838+ (copy-directory-tree
3939+ (merge-pathnames #P"lib/common-lisp/quicklisp/quicklisp/" quicklisp-prototype-dir)
4040+ (merge-pathnames #P"quicklisp/" target-dir)))
4141+4242+(defun call-with-quicklisp (function &key (target-dir :temp) (cache-dir :temp))
4343+ "Invoke the given function with the path to a quicklisp installation.
4444+4545+Quicklisp will be loaded before the function is called. `target-dir'
4646+can either be a pathname for the place where quicklisp should be
4747+installed or `:temp' to request installation in a temporary directory.
4848+`cache-dir' can either be a pathname for a place to store fasls or
4949+`:temp' to request caching in a temporary directory."
5050+ (when (find-package :ql)
5151+ (error "Already loaded quicklisp in this process"))
5252+ (labels
5353+ ((make-ql (ql-dir)
5454+ (prepare-quicklisp-dir ql-dir *quicklisp*)
5555+ (with-temporary-asdf-cache (ql-dir)
5656+ (load (merge-pathnames #P"setup.lisp" ql-dir))
5757+ (if (eq :temp cache-dir)
5858+ (funcall function ql-dir)
5959+ (with-asdf-cache (ql-dir cache-dir)
6060+ (funcall function ql-dir))))))
6161+ (if (eq :temp target-dir)
6262+ (with-temporary-directory (dir)
6363+ (make-ql dir))
6464+ (make-ql target-dir))))
6565+6666+(defmacro with-quicklisp ((quicklisp-dir) (&key (cache-dir :temp)) &body body)
6767+ "Install quicklisp in a temporary directory, load it, bind
6868+`quicklisp-dir' to the path where quicklisp was installed, and then
6969+evaluate `body'.
7070+7171+`cache-dir' can either be a pathname for a place to store fasls or
7272+`:temp' to request caching in a temporary directory."
7373+ `(call-with-quicklisp
7474+ (lambda (,quicklisp-dir)
7575+ ,@body)
7676+ :cache-dir ,cache-dir))
···11+(unless (find-package :ql-to-nix-util)
22+ (load "util.lisp"))
33+(unless (find-package :ql-to-nix-quicklisp-bootstrap)
44+ (load "quicklisp-bootstrap.lisp"))
55+(defpackage :ql-to-nix-system-info
66+ (:use :common-lisp :ql-to-nix-quicklisp-bootstrap :ql-to-nix-util)
77+ (:export #:dump-image))
88+(in-package :ql-to-nix-system-info)
99+1010+(declaim (optimize (debug 3) (speed 0) (space 0) (compilation-speed 0) (safety 3)))
1111+1212+;; This file cannot have any dependencies beyond quicklisp and asdf.
1313+;; Otherwise, we'll miss some dependencies!
1414+1515+;; We can't load quicklisp until runtime (at which point we'll create
1616+;; an isolated quicklisp installation). These wrapper functions are
1717+;; nicer than funcalling intern'd symbols every time we want to talk
1818+;; to quicklisp.
1919+(wrap :ql apply-load-strategy)
2020+(wrap :ql compute-load-strategy)
2121+(wrap :ql show-load-strategy)
2222+(wrap :ql quicklisp-systems)
2323+(wrap :ql ensure-installed)
2424+(wrap :ql quicklisp-releases)
2525+(wrap :ql-dist archive-md5)
2626+(wrap :ql-dist archive-url)
2727+(wrap :ql-dist ensure-local-archive-file)
2828+(wrap :ql-dist find-system)
2929+(wrap :ql-dist local-archive-file)
3030+(wrap :ql-dist name)
3131+(wrap :ql-dist provided-systems)
3232+(wrap :ql-dist release)
3333+(wrap :ql-dist short-description)
3434+(wrap :ql-dist system-file-name)
3535+(wrap :ql-impl-util call-with-quiet-compilation)
3636+3737+(defvar *version* (uiop:getenv "version")
3838+ "The version number of this program")
3939+4040+(defvar *main-system* nil
4141+ "The name of the system we're trying to extract info from.")
4242+4343+(defvar *found-parasites* (make-hash-table :test #'equalp)
4444+ "Names of systems which have been identified as parasites.
4545+4646+A system is parasitic if its name doesn't match the name of the file
4747+it is defined in. So, for example, if foo and foo-bar are both
4848+defined in a file named foo.asd, foo would be the host system and
4949+foo-bar would be a parasitic system.
5050+5151+Parasitic systems are not generally loaded without loading the host
5252+system first.
5353+5454+Keys are system names. Values are unspecified.")
5555+5656+(defvar *found-dependencies* (make-hash-table :test #'equalp)
5757+ "Hash table containing the set of dependencies discovered while installing a system.
5858+5959+Keys are system names. Values are unspecified.")
6060+6161+(defun decode-asdf-dependency (name)
6262+ "Translates an asdf system dependency description into a system name.
6363+6464+For example, translates (:version :foo \"1.0\") into \"foo\"."
6565+ (etypecase name
6666+ (symbol
6767+ (setf name (symbol-name name)))
6868+ (string)
6969+ (cons
7070+ (ecase (first name)
7171+ (:version
7272+ (warn "Discarding version information ~A" name)
7373+ ;; There's nothing we can do about this. If the version we
7474+ ;; have around is good enough, then we're golden. If it isn't
7575+ ;; good enough, then we'll error out and let a human figure it
7676+ ;; out.
7777+ (setf name (second name))
7878+ (return-from decode-asdf-dependency
7979+ (decode-asdf-dependency name)))
8080+8181+ (:feature
8282+ (if (find (second name) *features*)
8383+ (return-from decode-asdf-dependency
8484+ (decode-asdf-dependency (third name)))
8585+ (progn
8686+ (warn "Dropping dependency due to missing feature: ~A" name)
8787+ (return-from decode-asdf-dependency nil))))
8888+8989+ (:require
9090+ ;; This probably isn't a dependency we can satisfy using
9191+ ;; quicklisp, but we might as well try anyway.
9292+ (return-from decode-asdf-dependency
9393+ (decode-asdf-dependency (second name)))))))
9494+ (string-downcase name))
9595+9696+(defun found-new-parasite (system-name)
9797+ "Record that the given system has been identified as a parasite."
9898+ (setf system-name (decode-asdf-dependency system-name))
9999+ (setf (gethash system-name *found-parasites*) t)
100100+ (when (nth-value 1 (gethash system-name *found-dependencies*))
101101+ (error "Found dependency on parasite")))
102102+103103+(defun known-parasite-p (system-name)
104104+ "Have we previously identified this system as a parasite?"
105105+ (nth-value 1 (gethash system-name *found-parasites*)))
106106+107107+(defun found-parasites ()
108108+ "Return a vector containing all identified parasites."
109109+ (let ((systems (make-array (hash-table-size *found-parasites*) :fill-pointer 0)))
110110+ (loop :for system :being :the :hash-keys :of *found-parasites* :do
111111+ (vector-push system systems))
112112+ systems))
113113+114114+(defvar *track-dependencies* nil
115115+ "When this variable is nil, found-new-dependency will not record
116116+depdendencies.")
117117+118118+(defun parasitic-relationship-p (potential-host potential-parasite)
119119+ "Returns t if potential-host and potential-parasite have a parasitic relationship.
120120+121121+See `*found-parasites*'."
122122+ (let ((host-ql-system (find-system potential-host))
123123+ (parasite-ql-system (find-system potential-parasite)))
124124+ (and host-ql-system parasite-ql-system
125125+ (not (equal (name host-ql-system)
126126+ (name parasite-ql-system)))
127127+ (equal (system-file-name host-ql-system)
128128+ (system-file-name parasite-ql-system)))))
129129+130130+(defun found-new-dependency (name)
131131+ "Record that the given system has been identified as a dependency.
132132+133133+The named system may not be recorded as a dependency. It may be left
134134+out for any number of reasons. For example, if `*track-dependencies*'
135135+is nil then this function does nothing. If the named system isn't a
136136+quicklisp system, this function does nothing."
137137+ (setf name (decode-asdf-dependency name))
138138+ (unless name
139139+ (return-from found-new-dependency))
140140+ (unless *track-dependencies*
141141+ (return-from found-new-dependency))
142142+ (when (known-parasite-p name)
143143+ (return-from found-new-dependency))
144144+ (when (parasitic-relationship-p *main-system* name)
145145+ (found-new-parasite name)
146146+ (return-from found-new-dependency))
147147+ (unless (find-system name)
148148+ (return-from found-new-dependency))
149149+ (setf (gethash name *found-dependencies*) t))
150150+151151+(defun forget-dependency (name)
152152+ "Whoops. Did I say that was a dependency? My bad.
153153+154154+Be very careful using this function! You can remove a system from the
155155+dependency list, but you can't remove other effects associated with
156156+this system. For example, transitive dependencies might still be in
157157+the dependency list."
158158+ (setf name (decode-asdf-dependency name))
159159+ (remhash name *found-dependencies*))
160160+161161+(defun found-dependencies ()
162162+ "Return a vector containing all identified dependencies."
163163+ (let ((systems (make-array (hash-table-size *found-dependencies*) :fill-pointer 0)))
164164+ (loop :for system :being :the :hash-keys :of *found-dependencies* :do
165165+ (vector-push system systems))
166166+ systems))
167167+168168+(defun host-system (system-name)
169169+ "If the given system is a parasite, return the name of the system that is its host.
170170+171171+See `*found-parasites*'."
172172+ (let* ((system (find-system system-name))
173173+ (host-file (system-file-name system)))
174174+ (unless (equalp host-file system-name)
175175+ host-file)))
176176+177177+(defun get-loaded (system)
178178+ "Try to load the named system using quicklisp and record any
179179+dependencies quicklisp is aware of.
180180+181181+Unlike `our-quickload', this function doesn't attempt to install
182182+missing dependencies."
183183+ ;; Let's get this party started!
184184+ (let* ((strategy (compute-load-strategy system))
185185+ (ql-systems (quicklisp-systems strategy)))
186186+ (dolist (dep ql-systems)
187187+ (found-new-dependency (name dep)))
188188+ (show-load-strategy strategy)
189189+ (labels
190190+ ((make-go ()
191191+ (apply-load-strategy strategy)))
192192+ (call-with-quiet-compilation #'make-go)
193193+ (let ((asdf-system (asdf:find-system system)))
194194+ ;; If ASDF says that it needed a system, then we should
195195+ ;; probably track that.
196196+ (dolist (asdf-dep (asdf:component-sideway-dependencies asdf-system))
197197+ (found-new-dependency asdf-dep))
198198+ (dolist (asdf-dep (asdf:system-defsystem-depends-on asdf-system))
199199+ (found-new-dependency asdf-dep))))))
200200+201201+(defun our-quickload (system)
202202+ "Attempt to install a package like quicklisp would, but record any
203203+dependencies that are detected during the install."
204204+ (setf system (string-downcase system))
205205+ ;; Load it quickly, but do it OUR way. Turns out our way is very
206206+ ;; similar to the quicklisp way...
207207+ (let ((already-tried (make-hash-table :test #'equalp))) ;; Case insensitive
208208+ (tagbody
209209+ retry
210210+ (handler-case
211211+ (get-loaded system)
212212+ (asdf/find-component:missing-dependency (e)
213213+ (let ((required-by (asdf/find-component:missing-required-by e))
214214+ (missing (asdf/find-component:missing-requires e)))
215215+ (unless (typep required-by 'asdf:system)
216216+ (error e))
217217+ (when (gethash missing already-tried)
218218+ (error "Dependency loop? ~A" missing))
219219+ (setf (gethash missing already-tried) t)
220220+ (let ((parasitic-p (parasitic-relationship-p *main-system* missing)))
221221+ (if parasitic-p
222222+ (found-new-parasite missing)
223223+ (found-new-dependency missing))
224224+ ;; We always want to track the dependencies of systems
225225+ ;; that share an asd file with the main system. The
226226+ ;; whole asd file should be loadable. Otherwise, we
227227+ ;; don't want to include transitive dependencies.
228228+ (let ((*track-dependencies* parasitic-p))
229229+ (our-quickload missing)))
230230+ (format t "Attempting to load ~A again~%" system)
231231+ (go retry)))))))
232232+233233+(defvar *blacklisted-parasites*
234234+ #("hu.dwim.stefil/documentation" ;; This system depends on :hu.dwim.stefil.test, but it should depend on hu.dwim.stefil/test
235235+ "named-readtables/doc" ;; Dependency cycle between named-readtabes and mgl-pax
236236+ "symbol-munger-test" ;; Dependency cycle between lisp-unit2 and symbol-munger
237237+ "cl-postgres-simple-date-tests" ;; Dependency cycle between cl-postgres and simple-date
238238+ "cl-containers/with-variates") ;; Symbol conflict between cl-variates:next-element, metabang.utilities:next-element
239239+ "A vector of systems that shouldn't be loaded by `quickload-parasitic-systems'.
240240+241241+These systems are known to be troublemakers. In some sense, all
242242+parasites are troublemakers (you shouldn't define parasitic systems!).
243243+However, these systems prevent us from generating nix packages and are
244244+thus doubly evil.")
245245+246246+(defvar *blacklisted-parasites-table*
247247+ (let ((ht (make-hash-table :test #'equalp)))
248248+ (loop :for system :across *blacklisted-parasites* :do
249249+ (setf (gethash system ht) t))
250250+ ht)
251251+ "A hash table where each entry in `*blacklisted-parasites*' is an
252252+entry in the table.")
253253+254254+(defun blacklisted-parasite-p (system-name)
255255+ "Returns non-nil if the named system is blacklisted"
256256+ (nth-value 1 (gethash system-name *blacklisted-parasites-table*)))
257257+258258+(defun quickload-parasitic-systems (system)
259259+ "Attempt to load all the systems defined in the same asd as the named system.
260260+261261+Blacklisted systems are skipped. Dependencies of the identified
262262+parasitic systems will be tracked."
263263+ (let* ((asdf-system (asdf:find-system system))
264264+ (source-file (asdf:system-source-file asdf-system)))
265265+ (cond
266266+ (source-file
267267+ (loop :for system-name :being :the :hash-keys :of asdf/find-system:*defined-systems* :do
268268+ (when (and (parasitic-relationship-p system system-name)
269269+ (not (blacklisted-parasite-p system-name)))
270270+ (found-new-parasite system-name)
271271+ (let ((*track-dependencies* t))
272272+ (our-quickload system-name)))))
273273+ (t
274274+ (unless (or (equal "uiop" system)
275275+ (equal "asdf" system))
276276+ (warn "No source file for system ~A. Can't identify parasites." system))))))
277277+278278+(defun determine-dependencies (system)
279279+ "Load the named system and return a sorted vector containing all the
280280+quicklisp systems that were loaded to satisfy dependencies.
281281+282282+This function should probably only be called once per process!
283283+Subsequent calls will miss dependencies identified by earlier calls."
284284+ (tagbody
285285+ retry
286286+ (restart-case
287287+ (let ((*standard-output* (make-broadcast-stream))
288288+ (*trace-output* (make-broadcast-stream))
289289+ (*main-system* system)
290290+ (*track-dependencies* t))
291291+ (our-quickload system)
292292+ (quickload-parasitic-systems system))
293293+ (try-again ()
294294+ :report "Start the quickload over again"
295295+ (go retry))
296296+ (die ()
297297+ :report "Just give up and die"
298298+ (uiop:quit 1))))
299299+300300+ ;; Systems can't depend on themselves!
301301+ (forget-dependency system)
302302+ (values))
303303+304304+(defun parasitic-system-data (parasite-system)
305305+ "Return a plist of information about the given known-parastic system.
306306+307307+Sometimes we are asked to provide information about a system that is
308308+actually a parasite. The only correct response is to point them
309309+toward the host system. The nix package for the host system should
310310+have all the dependencies for this parasite already recorded.
311311+312312+The plist is only meant to be consumed by other parts of
313313+quicklisp-to-nix."
314314+ (let ((host-system (host-system parasite-system)))
315315+ (list
316316+ :system parasite-system
317317+ :host host-system
318318+ :name (string-downcase (format nil "~a" parasite-system))
319319+ :host-name (string-downcase (format nil "~a" host-system)))))
320320+321321+(defun system-data (system)
322322+ "Produce a plist describing a system.
323323+324324+The plist is only meant to be consumed by other parts of
325325+quicklisp-to-nix."
326326+ (when (host-system system)
327327+ (return-from system-data
328328+ (parasitic-system-data system)))
329329+330330+ (determine-dependencies system)
331331+ (let*
332332+ ((dependencies (sort (found-dependencies) #'string<))
333333+ (parasites (coerce (sort (found-parasites) #'string<) 'list))
334334+ (ql-system (find-system system))
335335+ (ql-release (release ql-system))
336336+ (ql-sibling-systems (provided-systems ql-release))
337337+ (url (archive-url ql-release))
338338+ (local-archive (local-archive-file ql-release))
339339+ (local-url (format nil "file://~a" (pathname local-archive)))
340340+ (archive-data
341341+ (progn
342342+ (ensure-local-archive-file ql-release)
343343+ ;; Stuff this archive into the nix store. It was almost
344344+ ;; certainly going to end up there anyway (since it will
345345+ ;; probably be fetchurl'd for a nix package). Also, putting
346346+ ;; it into the store also gives us the SHA we need.
347347+ (nix-prefetch-url local-url)))
348348+ (ideal-md5 (archive-md5 ql-release))
349349+ (raw-dependencies (coerce dependencies 'list))
350350+ (name (string-downcase (format nil "~a" system)))
351351+ (ql-sibling-names
352352+ (remove name (mapcar 'name ql-sibling-systems)
353353+ :test 'equal))
354354+ (dependencies raw-dependencies)
355355+ (description (asdf:system-description (asdf:find-system system)))
356356+ (release-name (short-description ql-release)))
357357+ (list
358358+ :system system
359359+ :description description
360360+ :sha256 (getf archive-data :sha256)
361361+ :url url
362362+ :md5 ideal-md5
363363+ :name name
364364+ :dependencies dependencies
365365+ :siblings ql-sibling-names
366366+ :release-name release-name
367367+ :parasites parasites)))
368368+369369+(defvar *error-escape-valve* *error-output*
370370+ "When `*error-output*' is rebound to inhibit spew, this stream will
371371+still produce output.")
372372+373373+(defun print-usage-and-quit ()
374374+ "Describe how to use this program... and then exit."
375375+ (format *error-output* "Usage:
376376+ ~A [--cacheDir <dir>] [--silent] [--debug] [--help|-h] <system-name>
377377+Arguments:
378378+ --cacheDir Store (and look for) compiled lisp files in the given directory
379379+ --verbose Show compilation output
380380+ --debug Enter the debugger when a fatal error is encountered
381381+ --help Print usage and exit
382382+ <system-name> The quicklisp system to examine
383383+" (or (uiop:argv0) "quicklisp-to-nix-system-info"))
384384+ (uiop:quit 2))
385385+386386+(defun main ()
387387+ "Make it go."
388388+ (let ((argv (uiop:command-line-arguments))
389389+ cache-dir
390390+ target-system
391391+ verbose-p
392392+ debug-p)
393393+ (handler-bind
394394+ ((warning
395395+ (lambda (w)
396396+ (format *error-escape-valve* "~A~%" w)))
397397+ (error
398398+ (lambda (e)
399399+ (if debug-p
400400+ (invoke-debugger e)
401401+ (progn
402402+ (format *error-escape-valve* "~
403403+Failed to extract system info. Details are below. ~
404404+Run with --debug and/or --verbose for more info.
405405+~A~%" e)
406406+ (uiop:quit 1))))))
407407+ (loop :while argv :do
408408+ (cond
409409+ ((equal "--cacheDir" (first argv))
410410+ (pop argv)
411411+ (unless argv
412412+ (error "--cacheDir expects an argument"))
413413+ (setf cache-dir (first argv))
414414+ (pop argv))
415415+416416+ ((equal "--verbose" (first argv))
417417+ (setf verbose-p t)
418418+ (pop argv))
419419+420420+ ((equal "--debug" (first argv))
421421+ (setf debug-p t)
422422+ (pop argv))
423423+424424+ ((or (equal "--help" (first argv))
425425+ (equal "-h" (first argv)))
426426+ (print-usage-and-quit))
427427+428428+ (t
429429+ (setf target-system (pop argv))
430430+ (when argv
431431+ (error "Can only operate on one system")))))
432432+433433+ (unless target-system
434434+ (print-usage-and-quit))
435435+436436+ (when cache-dir
437437+ (setf cache-dir (pathname-as-directory (parse-namestring cache-dir))))
438438+439439+ (with-quicklisp (dir) (:cache-dir (or cache-dir :temp))
440440+ (declare (ignore dir))
441441+442442+ (let (system-data)
443443+ (let ((*error-output* (if verbose-p
444444+ *error-output*
445445+ (make-broadcast-stream)))
446446+ (*standard-output* (if verbose-p
447447+ *standard-output*
448448+ (make-broadcast-stream)))
449449+ (*trace-output* (if verbose-p
450450+ *trace-output*
451451+ (make-broadcast-stream))))
452452+ (format *error-output*
453453+ "quicklisp-to-nix-system-info ~A~%ASDF ~A~%Quicklisp ~A~%Compiler ~A ~A~%"
454454+ *version*
455455+ (asdf:asdf-version)
456456+ (funcall (intern "CLIENT-VERSION" :ql))
457457+ (lisp-implementation-type)
458458+ (lisp-implementation-version))
459459+ (setf system-data (system-data target-system)))
460460+461461+ (cond
462462+ (system-data
463463+ (format t "~W~%" system-data)
464464+ (uiop:quit 0))
465465+ (t
466466+ (format *error-output* "Failed to determine system data~%")
467467+ (uiop:quit 1))))))))
468468+469469+(defun dump-image ()
470470+ "Make an executable"
471471+ (setf uiop:*image-entry-point* #'main)
472472+ (setf uiop:*lisp-interaction* nil)
473473+ (uiop:dump-image "quicklisp-to-nix-system-info" :executable t))