Commit 2af8d67e authored by Michael Raskin's avatar Michael Raskin

Syncing from Monotone at 20190410-024717. Last commit message was A tree node...

Syncing from Monotone at 20190410-024717. Last commit message was A tree node with nonemptiness check
parent a4a3bda0
......@@ -5,7 +5,14 @@ unset $(set | grep '^_.*NIX_LISP*' | cut -d = -f 1)
NIX_LISP_ASDF_PATHS="$(realpath "$(dirname "$0")")
$PWD"
for i in drakma cl_plus_ssl cl-html5-parser parenscript cl-ppcre cl-json css-selectors css-selectors-simple-tree babel $THOUGHTFUL_THERIDION_EXTRA_DEPENDENCIES; do
dependencies="drakma cl_plus_ssl cl-html5-parser parenscript cl-ppcre cl-json css-selectors css-selectors-simple-tree babel $THOUGHTFUL_THERIDION_EXTRA_DEPENDENCIES"
test -n "$THOUGHTFUL_THERIDION_NIX_GC_PIN" && {
mkdir -p "$(dirname "$THOUGHTFUL_THERIDION_NIX_GC_PIN")"
nix-build -E "with import <nixpkgs> {}; with lispPackages; buildEnv { name = ''thoughtful-theridion-dependencies''; paths = [ $dependencies ];}" -o "$THOUGHTFUL_THERIDION_NIX_GC_PIN"
}
for i in $dependencies; do
source "$(nix-build --no-out-link '<nixpkgs>' -A lispPackages.$i)"/lib/common-lisp-settings/*-path-config.sh
done
......
......@@ -24,5 +24,6 @@
#:page-walk-each
#:page-walk-each-of
#:page-walk-maybe-each-of
#:page-walk-each-of-nonempty
))
......@@ -28,6 +28,12 @@
(defmethod page-walk-maybe-each-of ((l page-walker-brancher))
(page-walk-maybe-each-of (page-walker-branches l)))
(defmacro page-walk-each-of-nonempty (l else)
(let ((var (gensym)))
`(let ((,var (page-walker-brancher-content ,l)))
(unless ,var ,else)
(page-walk-each-of ,var))))
(defun page-walker-brancher-content (x)
(cond ((typep x 'page-walker-brancher)
(loop for y in (page-walker-branches x)
......@@ -41,6 +47,7 @@
`(page-walk-each-of
,(if (null forms) nil
`(let ((,var ,(first forms)))
(declare (ignorable ,var))
(unless (page-walker-terminator-p ,var)
(list ,var
(page-walk-each ,@(rest forms)))))))))
......@@ -163,7 +170,7 @@
,(if use-fetcher
fetcher-var
`(parsed-content ,fetcher-var))))))
`(let* ((,var ,var)))))
`(let* ((,var ,var)) (declare (ignorable ,var)))))
(first-clause (first body))
(main-body
(if (null body)
......@@ -202,6 +209,7 @@
,rest-result-var)
collect ,rest-result-var)))
(let ((,var ,result-var))
(declare (ignorable ,var))
,rest-form))))
(,descend ,result-var))))))))
(main-wrapped (append top-wrapper (list main-body)))
......@@ -209,7 +217,9 @@
(if recur `(labels ((,recur (,var) ,main-wrapped))
(,recur ,var))
main-wrapped))
(full-computation-wrapped `(let ((,var ,value)) ,full-computation))
(full-computation-wrapped `(let ((,var ,value))
(declare (ignorable ,var))
,full-computation))
(unpacked-result
(if keep-brancher
full-computation-wrapped
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment