Commit 9250db77 authored by Didier Verna's avatar Didier Verna
Browse files

Merge branch 'master' into benchmark.

parents c5258c9e fd3f25f3
......@@ -77,9 +77,8 @@ files (logs, Texinfo, and HTML) can be found in `~/quickref/`.
#### Customization
In addition to the `:libraries` option, the `BUILD` function accepts a number
of keyword arguments allowing you to tweak the behavior of Quickref. In
particular, you have control on the output destination, error behavior, and a
(still) rudimentary support for parallelism. Please refer to the docstring for
more information.
particular, you have control on the output destination, error behavior, and
support for parallelism. Please refer to the docstring for more information.
## Docker images
......
......@@ -2,7 +2,7 @@
;;; declt --- Declt script for Quickref
;; Copyright (C) 2018 EPITA Research and Development Laboratory
;; Copyright (C) 2018, 2019 EPITA Research and Development Laboratory
;; Author: Didier Verna
;; Maintainers: Antoine Martin and Didier Verna
......@@ -28,7 +28,7 @@
;; Usage: declt SYSTEM-NAME [OPTIONS]
;; Available options:
;; --quicklisp-setup FILENAME (defaults to ~/quicklisp/setup.lisp)
;; --cache-directory DIRECTORY (defaults to the normal caching behavior)
;; --cache-directory DIRECTORY (defaults to the usual ASDF cache)
;; --texinfo-directory DIRECTORY (defaults to the current directory)
;; --introduction Make room for an introduction (no value)
......@@ -50,7 +50,7 @@
(princ "Usage: declt SYSTEM-NAME [OPTIONS]
Available options:
--quicklisp-setup FILENAME (defaults to ~/quicklisp/setup.lisp)
--cache-directory DIRECTORY (defaults to the normal caching behavior)
--cache-directory DIRECTORY (defaults to the usual ASDF cache)
--texinfo-directory DIRECTORY (defaults to the current directory)
--introduction Make room for an introduction (no value)
"
......@@ -103,7 +103,7 @@ Available options:
;; #### NOTE: Quickref doesn't brutally download the whole Quicklisp world
;; #### before starting to build manuals (it only downloads the releases
;; #### tarballs on demand, in order to figure out whther there's a README
;; #### tarballs on demand, in order to figure out whether there's a README
;; #### file inside). Consequently, we may end up running Declt on a library
;; #### which is installed but still missing some dependencies. Because of
;; #### that, we need to QL:QUICKLOAD it (as opposed to just
......
;;; fr.epita.lrde.quickref.core.asd --- ASDF system definition, core library
;; Copyright (C) 2018 EPITA Research and Development Laboratory
;; Copyright (C) 2018, 2019 EPITA Research and Development Laboratory
;; Author: Antoine Martin
;; Maintainers: Antoine Martin and Didier Verna
......@@ -36,16 +36,15 @@ more complete description of Quickref, see the fr.epita.lrde.quickref system."
:mailto "quickref-devel@common-lisp.net"
:license "BSD"
:version #.(fr.epita.lrde.quickref.setup:version :short)
:depends-on (:fr.epita.lrde.quickref.setup
:fr.epita.lrde.quickref.cmark
:depends-on (:fr.epita.lrde.quickref.cmark
:quicklisp :cl-ppcre :3bmd :net.didierverna.declt)
:serial t
:components ((:file "meta")
(:module "src"
:serial t
:components ((:file "util")
(:file "texinfo" :depends-on ("util"))
(:file "html" :depends-on ("util"))
(:file "quickref" :depends-on ("texinfo"
"html"))))))
(:file "texinfo")
(:file "html")
(:file "quickref")))))
;;; fr.epita.lrde.quickref.core.asd ends here
;;; meta.lisp --- Meta utilities
;; Copyright (C) 2018 EPITA Research and Development Laboratory
;; Copyright (C) 2018, 2019 EPITA Research and Development Laboratory
;; Author: Antoine Martin
;; Maintainers: Antoine Martin and Didier Verna
......@@ -51,10 +51,12 @@
:*output-directory*
:*makeinfo-path*
:*cross-reference-validation*
:*caching-behavior*
:*cache-policy*
:*empty-cache*
:*error-behavior*
:*parallel*
:*declt-threads*
:*makeinfo-threads*
;; From src/quickref.lisp:
:build))
......
;;; html.lisp --- HTML generation part
;; Copyright (C) 2018 EPITA Research and Development Laboratory
;; Copyright (C) 2018, 2019 EPITA Research and Development Laboratory
;; Author: Antoine Martin
;; Maintainers: Antoine Martin and Didier Verna
......@@ -151,6 +151,10 @@ it's alphabetic, or under # otherwise."
;; HTML Files
;; ==========================================================================
;; -----------------
;; README Management
;; -----------------
(defun markdown-html (string)
"Return Markdown STRING formatted as HTML.
Try our CommonMark FFI first, fall back to 3BMD otherwise."
......@@ -187,7 +191,14 @@ README contents is rendered in HTML and inserted as introduction."
;; UTF8...
(list :match (readme-html readme-file)))))))
(defun makeinfo (system-name)
;; ---------------
;; HTML Management
;; ---------------
;; #### FIXME: it would be better if this function returned the HTML file on
;; success.
(defun run-makeinfo (system-name)
"Run Makeinfo on ASDF SYSTEM-NAME. Return T on success."
(let* ((html-file (html-file system-name))
(log-errors (eq *error-behavior* :log)))
......@@ -216,64 +227,35 @@ README contents is rendered in HTML and inserted as introduction."
(format log "~A~%" error-output)))
(zerop status))))
(defgeneric build-html-manual (library &key silent)
#+()(defgeneric build-html-manual (library)
(:documentation "Build LIBRARY's HTML manual. Return T on success.")
(:method ((system-name string) &key silent)
(:method ((system-name string))
"Build ASDF SYSTEM-NAME's HTML manual. Return T on success."
(let ((log-errors (eq *error-behavior* :log)))
(unless silent (format t " Running Makeinfo~:[~%~;... ~]" log-errors))
(cond ((makeinfo system-name)
(when (and log-errors (not silent)) (format t "ok~%"))
(let ((readme-file (readme-file system-name)))
(when readme-file
(unless silent
(format t " Inserting ~A~:[~%~;... ~]"
(file-namestring readme-file)
log-errors))
(insert-readme-contents (html-file system-name) readme-file)
(when (and log-errors (not silent)) (format t "ok~%"))))
t)
(t
;; #### NOTE: if we reach that point (that is, without an error
;; signaled, it means that we're logging errors.
(unless silent (format t "ko~%"))
nil))))
(:method ((system ql-dist:system) &key silent)
;; #### WARNING: this asymmetry is not nice, but it will go away once
;; Declt itself is capable of README insertion.
(let ((result (with-progression ("Generating ~A.html" system-name)
(run-makeinfo system-name))))
(when result
(let ((readme-file (readme-file system-name)))
(when readme-file
(with-progression ("Inserting README file")
(insert-readme-contents (html-file system-name) readme-file))))
t)))
(:method ((system ql-dist:system))
"Build Quicklisp SYSTEM's HTML manual. Return T on success."
(build-html-manual (ql-dist:name system) :silent silent))
(:method ((release ql-dist:release) &key silent)
(build-html-manual (ql-dist:name system)))
(:method ((release ql-dist:release))
"Build Quicklisp RELEASE's HTML manual. Return T on success."
;; #### NOTE: this call is only here to ensure the presence of a potential
;; README file when calling the Declt script. It's needed beforehand to
;; make room in the Texinfo file for insertion as introduction (Declt
;; doesn't do this by itself yet).
(ql-dist:ensure-installed release)
(build-html-manual (primary-system release) :silent silent)))
(build-html-manual (primary-system release))))
#+()(defun build-html-manuals ()
"Build all reference manuals in HTML with Makeinfo."
(mapc #'build-html-manual (*.* (texinfo-directory)))
(values))
(defun build-html-manuals-// (mutex new-manual)
"Build HTML manuals, parallel version.
Return the number of HTML files successfully built."
(let ((htmls 0)
libraries)
(loop
(sb-thread:with-mutex (mutex)
(unless *libraries-queue* (sb-thread:condition-wait new-manual mutex))
(setq libraries *libraries-queue*
*libraries-queue* nil))
(when libraries
(format-// t "Got ~D Texinfo files to batch process.~%"
(- (length libraries) (if (eq (car (last libraries)) :done) 1 0)))
(dolist (library libraries)
(when (eq library :done) (return-from build-html-manuals-// htmls))
(cond ((build-html-manual library :silent t)
(format-// t "~A.html... ok.~%" (library-name library))
(incf htmls))
(t
(format-// t "~A.html... ko.~%" (library-name library)))))))))
;;; html.lisp ends here
;;; quickref.lisp --- Entry points
;; Copyright (C) 2018 EPITA Research and Development Laboratory
;; Copyright (C) 2018, 2019 EPITA Research and Development Laboratory
;; Author: Antoine Martin
;; Maintainers: Antoine Martin and Didier Verna
......@@ -23,36 +23,6 @@
;;; Comment:
;; #### NOTE: About parallelism.
;; The current support for parallelism is very basic: a thread waits for the
;; texinfo manuals to be generated sequentially, and then runs Makeinfo on
;; them, also sequentially. There is in fact not much to be gained from that.
;; Here are some ideas.
;; 1. HTML manuals can be built in parallel without any precaution, as there
;; are no dependencies between them. If the Texinfo manuals continue to be
;; built sequentially, it's not obvious if we would gain something (it
;; depends on the respective speed of Declt vs. Makeinfo).
;; 2. For Texinfo manuals, it's much more difficult becasue Declt loads the
;; libraries, which implies compilation. When removing compilation caches
;; between builds, it's impossible to parallelize, unless we use a
;; different cache directory for every build, so we would need to customize
;; ASDF's output translations. If we want to keep compilation caches, we
;; risk compiling the same library several times in parallel as a shared
;; dependency. What we need to do then, is consider the dependency graph,
;; and start building from the leaves, going upward.
;; 3. Finally, if we ever build the Texinfo manuals in parallel, it's not
;; clear whether we want to keep threads waiting for them, or whether we
;; want to simply call Makeinfo right after Declt, within the same
;; thread. In some sense, it's just like the sequential version: currently,
;; we build all Texinfos and then all HTMLs, but we could also
;; alternate. In fact, I think it would be even better to do it like this
;; because of the dependency chain (currently, we scan the Texinfo
;; directory for files and we need to get back to release names from file
;; names etc.).
;;; Code:
......@@ -67,8 +37,18 @@ Return :html, :texi or NIL, indicating how far the process went.")
"Build ASDF SYSTEM-NAME's reference manual.
Return :html, :texi or NIL, indicating how far the process went."
(format t "Building ~A manual...~%" system-name)
(when (build-texinfo-manual system-name)
(if (build-html-manual system-name) :html :texi)))
;; #### WARNING: this asymmetry is not nice, but it will go away once
;; Declt itself is capable of README insertion.
(when (with-progression (" Running Declt") (run-declt system-name))
(cond ((with-progression (" Running Makeinfo")
(run-makeinfo system-name))
(let ((readme-file (readme-file system-name)))
(when readme-file
(with-progression (" Inserting README file")
(insert-readme-contents (html-file system-name)
readme-file))))
:html)
(t :texi))))
(:method ((system ql-dist:system))
"Build Quicklisp SYSTEM's reference manual.
Return :html, :texi or NIL, indicating how far the process went."
......@@ -95,32 +75,10 @@ Return :html, :texi or NIL, indicating how far the process went."
(:texi (incf texis))
(:html (incf texis) (incf htmls)))
:finally (format t "~
Successfully built ~D/~D manuals (~D Declt errors, ~D Makeinfo errors).~%"
Successfully built ~D/~D manual~:P (~D Declt error~:P, ~D Makeinfo error~:P).~%"
htmls total (- total texis) (- texis htmls)))
(values))
;; #### FIXME: the parallel option depends on SBCL having been compiled with
;; support for multi-threading, so the feature should be in a separate module
;; with conditional inclusion.
(defun build-manuals-// (libraries)
"Build LIBRARIES reference manuals.
This is the parallel version."
(setq *libraries-queue* nil)
(let* ((total (length libraries))
texis
htmls
(mutex (sb-thread:make-mutex))
(new-manual (sb-thread:make-waitqueue))
(thread (sb-thread:make-thread
(lambda () (build-html-manuals-// mutex new-manual)))))
(setq texis (build-texinfo-manuals-// libraries mutex new-manual))
(setq htmls (sb-thread:join-thread thread))
(format t "~
Successfully built ~D/~D manuals (~D Declt errors, ~D Makeinfo errors).~%"
htmls total (- total texis) (- texis htmls)))
(values))
(defvar *other-systems-names* '("asdf" "fr.epita.lrde.quickref")
"Non-Quicklisp systems that need to be documented.")
......@@ -130,30 +88,43 @@ Successfully built ~D/~D manuals (~D Declt errors, ~D Makeinfo errors).~%"
(makeinfo-path *makeinfo-path*)
(cross-reference-validation *cross-reference-validation*)
(error-behavior *error-behavior*)
(caching-behavior *caching-behavior*)
(cache-policy *cache-policy*)
(empty-cache *empty-cache*)
(parallel *parallel*))
(parallel *parallel*)
(declt-threads *declt-threads*)
(makeinfo-threads *makeinfo-threads*))
"Build the Quickref website.
All keywords to this function are defaulted to their corresponding global
parameter, which see."
(when update
(ql:update-client :prompt nil)
(ql:update-dist (quicklisp-distribution) :prompt nil))
(setq libraries (if (eq libraries :all)
(ql-dist:provided-releases (quicklisp-distribution))
(ql-dist:installed-releases (quicklisp-distribution))))
(let ((*output-directory* output-directory)
(*makeinfo-path* makeinfo-path)
(*cross-reference-validation* cross-reference-validation)
(*error-behavior* error-behavior)
(*caching-behavior* caching-behavior)
(*empty-cache* empty-cache)
(*parallel* parallel))
(when update
(ql:update-client :prompt nil)
(ql:update-dist (quicklisp-distribution) :prompt nil))
(*cache-policy* cache-policy)
(*empty-cache* empty-cache))
(ensure-quickref-directory :declt t :makeinfo t)
(setq libraries (append
*other-systems-names*
(if (eq libraries :all)
(ql-dist:provided-releases (quicklisp-distribution))
(ql-dist:installed-releases (quicklisp-distribution)))))
(format t "~D manuals to build.~%" (length libraries))
(funcall (if parallel #'build-manuals-// #'build-manuals) libraries)
(format t "~D foreign manual~:P to build.~%" (length *other-systems-names*))
(build-manuals *other-systems-names*)
(format t "~D Quicklisp manual~:P to build.~%" (length libraries))
(ecase parallel
((nil) (build-manuals libraries))
(1 (if (fboundp 'build-manuals-//-1)
(funcall #'build-manuals-//-1 libraries)
(error "Parallel support is unavailable.")))
(2 (if (fboundp 'build-manuals-//-2)
(funcall #'build-manuals-//-2
libraries declt-threads makeinfo-threads)
(error "Parallel support is unavailable.")))
(3 (if (fboundp 'build-manuals-//-3)
(funcall #'build-manuals-//-3
libraries declt-threads makeinfo-threads)
(error "Parallel support is unavailable."))))
(build-index-file)
(copy-style-sheets))
(values))
......
;;; texinfo.lisp --- Texinfo generation part
;; Copyright (C) 2018 EPITA Research and Development Laboratory
;; Copyright (C) 2018, 2019 EPITA Research and Development Laboratory
;; Author: Didier Verna
;; Maintainers: Antoine Martin and Didier Verna
......@@ -36,7 +36,7 @@
"Quickref's Declt script.")
(defun declt (system-name)
(defun run-declt (system-name)
"Run Declt on ASDF SYSTEM-NAME. Return T on success."
(let ((log-errors (eq *error-behavior* :log))
(readme-file (readme-file system-name)))
......@@ -46,7 +46,7 @@
"--script" ,(namestring *declt-script*)
,system-name
"--quicklisp-setup" ,(namestring (ql-setup:qmerge "setup.lisp"))
,@(unless (eq *caching-behavior* :global)
,@(unless (eq *cache-policy* :global)
`("--cache-directory" ,(namestring (cache-directory))))
"--texinfo-directory" ,(namestring (texinfo-directory))
,@(when readme-file '("--introduction")))
......@@ -63,31 +63,23 @@
(format log "~A~%" error-output)))
(zerop status))))
(defgeneric build-texinfo-manual (library &key silent)
#+()(defgeneric build-texinfo-manual (library)
(:documentation "Build LIBRARY's Texinfo manual. Return T on success.")
(:method ((system-name string) &key silent)
(:method ((system-name string))
"Build ASDF SYSTEM-NAME's Texinfo manual. Return T on success."
(let ((log-errors (eq *error-behavior* :log)))
(unless silent (format t " Running Declt~:[~%~;... ~]" log-errors))
(cond ((declt system-name)
(when (and log-errors (not silent)) (format t "ok~%"))
t)
(t
;; #### NOTE: if we reach that point (that is, without an error
;; signaled, it means that we're logging errors.
(unless silent (format t "ko~%"))
nil))))
(:method ((system ql-dist:system) &key silent)
(with-progression ("Generating ~A.texi" system-name)
(run-declt system-name)))
(:method ((system ql-dist:system))
"Build Quicklisp SYSTEM's Texinfo manual. Return T on success."
(build-texinfo-manual (ql-dist:name system) :silent silent))
(:method ((release ql-dist:release) &key silent)
(build-texinfo-manual (ql-dist:name system)))
(:method ((release ql-dist:release))
"Build Quicklisp RELEASE's Texinfo manual. Return T on success."
;; #### NOTE: this call is only here to ensure the presence of a potential
;; README file when calling the Declt script. It's needed beforehand to
;; make room in the Texinfo file for insertion as introduction (Declt
;; doesn't do this by itself yet).
(ql-dist:ensure-installed release)
(build-texinfo-manual (primary-system release) :silent silent)))
(build-texinfo-manual (primary-system release))))
#+()(defun build-texinfo-manuals (libraries)
"Build LIBRARIES Texinfo manuals."
......@@ -95,28 +87,4 @@
(mapc #'build-texinfo-manual libraries)
(values))
(defvar *libraries-queue* nil)
(defun build-texinfo-manuals-// (libraries mutex new-manual)
"Build LIBRARIES Texinfo manuals, parallel version.
Return the number of Texinfo files successfully built."
(loop :with total := (length libraries)
:and texis := 0
:for count :from 1
:for library :in libraries
:do (cond ((build-texinfo-manual library :silent t)
(format-// t "(~D/~D) ~A.texi... ok.~%"
count total (library-name library))
(incf texis)
(sb-thread:with-mutex (mutex)
(endpush library *libraries-queue*)
(sb-thread:condition-notify new-manual)))
(t
(format-// t "(~D/~D) ~A.texi... ko.~%"
count total (library-name library))))
:finally (progn (sb-thread:with-mutex (mutex)
(endpush :done *libraries-queue*)
(sb-thread:condition-notify new-manual))
(return texis))))
;;; texinfo.lisp ends here
;;; util.lisp --- Miscellaneous utilities
;; Copyright (C) 2018 EPITA Research and Development Laboratory
;; Copyright (C) 2018, 2019 EPITA Research and Development Laboratory
;; Author: Didier Verna
;; Maintainers: Antoine Martin and Didier Verna
......@@ -27,7 +27,7 @@
;; ==========================================================================
;; User-Level Behavior Settings
;; User-Level Configuration
;; ==========================================================================
(defparameter *update* t
......@@ -54,15 +54,16 @@ Possible values are:
Validation will help catch Declt bugs, but also prevent otherwise usable
manuals from being generated.")
(defparameter *caching-behavior* :global
"Behavior to adopt with respect to compilation cache (:global by default).
If :global, the normal behavior is honored, meaning that compilation caches
(defparameter *cache-policy* :global
"Compilation cache handling policy (:global by default).
If :global, the usual ASDF cache is used, meaning that compilation caches
are shared across Declt calls. Otherwise, every Declt call uses a different
cache.")
compilation cache.")
(defparameter *empty-cache* t
"Whether to empty the compilation cache before proceeding.
Note that this parameter only makes sense when the caching behavior is local.")
This parameter is only considered for a local cache policy. The global ASDF
cache is never emptied.")
(defparameter *error-behavior* :log
"Behavior to adopt when errors are encountered (:log by default).
......@@ -71,8 +72,63 @@ first error. Note also that when errors are logged (which is meant to be the
non-interactive way of running Quickref), normal output from Declt and
Makeinfo is discarded completely.")
;; #### NOTE: the question of whether these should be defined in the parallel
;; module may be raised. This would complicate the code in the BUILD function
;; however.
(defparameter *parallel* nil
"Whether to parallelize the build process (NIL by default).")
"Whether to parallelize the build process (NIL by default).
If not null, the value must be the parallel version number to use (1).")
(defparameter *declt-threads* 2
"Number of threads to use for Declt (Texinfo generation).")
(defparameter *makeinfo-threads* 2
"Number of threads to use for Makeinfo (HTML generation).")
;; ==========================================================================
;; Miscellaneous Utilities
;; ==========================================================================
(defmacro while (test &rest body)
"The WHILE loop."
`(do () ((not ,test))
,@body))
(defmacro endpush (object place)
"Like PUSH, but at the end."
`(setf ,place (nconc ,place (list ,object))))
(defgeneric trim (object)
(:documentation "Remove potential CL- prefix from OBJECT's name.")
(:method ((string string))
"Remove potential CL- prefix from STRING."
(if (and (> (length string) 3) (string= (subseq string 0 3) "cl-"))
(subseq string 3)
string))
(:method ((system ql-dist:system))
"Remove potential CL- prefix from SYSTEM's name."
(trim (ql-dist:name system)))
(:method ((release ql-dist:release))
"Remove potential CL- prefix from RELEASE's name."
(trim (ql-dist:name release))))
(defmacro with-progression ((message &rest arguments) &body body)
"Execute BODY with a progression indicator. Return BODY's value.
MESSAGE and ARGUMENTS are passed to FORMAT to print the progression.
If Quickref errors are logged, the indicator is then followed by an elision,
eventually terminated by either ok or ko upon completion."
(let ((log (gensym "log"))
(result (gensym "result")))
`(let ((,log (eq *error-behavior* :log))
,result)
(format t ,(concatenate 'string message "~:[~%~;... ~]")
,@arguments ,log)
(finish-output)
(setq ,result (multiple-value-list (progn ,@body)))
(when ,log (format t "~:[ko~;ok~]~%" (car ,result)))
(values-list ,result))))
......@@ -149,49 +205,6 @@ The primary system is determined heuristically as follows:
(lambda (name1 name2) (< (length name1) (length name2)))
:key #'ql-dist:name)))))
(defgeneric library-name (library)
(:documentation "Return LIBRARY's name.")
(:method ((system-name string))
"Return ASDF SYSTEM-NAME."
system-name)
(:method ((system ql-dist:system))
"Return Quicklisp SYSTEM's name."
(ql-dist:name system))
(:method ((release ql-dist:release))
"Return Quicklisp RELEASE's primary system's name."
(library-name (primary-system release))))
;; ==========================================================================
;; Miscellaneous Utilities
;; ==========================================================================
(defmacro endpush (object place)
"Like PUSH, but at the end."
`(setf ,place (nconc ,place (list ,object))))
(defgeneric trim (object)
(:documentation "Remove potential CL- prefix from OBJECT's name.")
(:method ((string string))
"Remove potential CL- prefix from STRING."
(if (and (> (length string) 3) (string= (subseq string 0 3) "cl-"))
(subseq string 3)
string))
(:method ((system ql-dist:system))
"Remove potential CL- prefix from SYSTEM's name."
(trim (ql-dist:name system)))
(:method ((release ql-dist:release))
"Remove potential CL- prefix from RELEASE's name."
(trim (ql-dist:name release))))
(defmacro format-// (stream &rest args)
"Like FORMAT, but block until all output is flushed."
(let ((the-stream (gensym "stream")))
`(let ((,the-stream ,stream))
(format ,the-stream ,@args)
(finish-output ,the-stream))))
;; ==========================================================================
......@@ -294,7 +307,7 @@ Safely means try to detect a proper encoding."
(defun cache-directory ()
"Return Quickref's compilation cache root directory.
This is the location used when the caching behavior is local. ASDF and Declt
This is the location used when the cache policy is local. ASDF and Declt
get their own subdirectory, every documented system also has its own one,
leading to duplicate compilation of every shared dependency."
(merge-pathnames #p"cache/" *output-directory*))
......@@ -303,9 +316,9 @@ leading to duplicate compilation of every shared dependency."
(defun ensure-quickref-directory (&key declt makeinfo)
"Make sure we have fresh DECLT and/or MAKEINFO directories.
Th