[alexandria-cvs] updated branch master: 2dfc9b5... fix: assoc-value setter now always returns the new value
Nikodemus Siivola
nsiivola at common-lisp.net
Mon Mar 8 12:02:24 UTC 2010
The branch master has been updated:
discards 34949e184e892240d0197bae46ad0924fcb2f51b (commit)
discards a2c71efed048596cb0fbc734e814248d00a2601f (commit)
discards 681f8735c613fa96a9cf12ddf76ce45197745011 (commit)
discards b5cc04c27491e872065821b7f2aae24d3701b6c0 (commit)
discards 035846561e47e1f7531f21e49cacc58f007cfc9b (commit)
discards 66bd88d5eab762a6080ec4be197b82570d9e7b49 (commit)
This update discarded existing revisions and left the branch pointing at
a previous point in the repository history.
* -- * -- N (2dfc9b549ef963f4d2a895d0404259a5e69b6151)
\
O -- O -- O (34949e184e892240d0197bae46ad0924fcb2f51b)
The removed revisions are not necessarilly gone - if another reference
still refers to them they will stay in the repository.
No new revisions were added by this update.
Summary of changes:
README | 3 --
control-flow.lisp | 62 +++++++---------------------------------------------
doc/Makefile | 9 +------
package.lisp | 1 -
tests.lisp | 2 +-
5 files changed, 12 insertions(+), 65 deletions(-)
delete mode 100644 README
diff --git a/README b/README
deleted file mode 100644
index 930e7ec..0000000
--- a/README
+++ /dev/null
@@ -1,3 +0,0 @@
-Alexandria
-
-A collection of portable public domain utilities for Common Lisp.
diff --git a/control-flow.lisp b/control-flow.lisp
index 8225442..42a88f9 100644
--- a/control-flow.lisp
+++ b/control-flow.lisp
@@ -52,20 +52,15 @@ returns the values of DEFAULT if no keys match."
(setf possibilities (mapcar (lambda (p) (macroexpand p env)) possibilities))
(if (every (lambda (p) (constantp p)) possibilities)
`(svref (load-time-value (vector , at possibilities)) (random ,(length possibilities)))
- (labels ((expand (possibilities position random-number)
- (if (null (cdr possibilities))
- (car possibilities)
- (let* ((length (length possibilities))
- (half (truncate length 2))
- (second-half (nthcdr half possibilities))
- (first-half (butlast possibilities (- length half))))
- `(if (< ,random-number ,(+ position half))
- ,(expand first-half position random-number)
- ,(expand second-half (+ position half) random-number))))))
- (with-gensyms (random-number)
- (let ((length (length possibilities)))
- `(let ((,random-number (random ,length)))
- ,(expand possibilities 0 random-number)))))))
+ (with-gensyms (function)
+ `(let ((,function (lambda () ,(pop possibilities))))
+ (declare (function ,function))
+ ,@(let ((p 1))
+ (mapcar (lambda (possibility)
+ `(when (zerop (random ,(incf p)))
+ (setf ,function (lambda () ,possibility))))
+ possibilities))
+ (funcall ,function)))))
(defmacro xor (&rest datums)
"Evaluates its argument one at a time, from left to right. If more then one
@@ -104,42 +99,3 @@ NIL."
"Like CL:MULTIPLE-VALUE-PROG1, except it saves the values of the
second form."
`(progn ,first-form (multiple-value-prog1 ,second-form , at body)))
-
-(defmacro ensuref (place thing &rest more &environment env)
- "If PLACE evaluates to NIL set it to THING, otherwise leave PLACE unchanged.
-
-\(ENSUREF PLACE THING) is approximately equivalent to
-
- (SETF PLACE (OR PLACE THING))
-
-except that ENSUREF ensures that PLACE is evaluated only once, and except that
-PLACE isn't set at all if it evaluated to NIL.
-
-Example:
-
- (let ((a nil)
- (b :foo)
- (c (list 1 2 nil 4)))
- (ensuref a :a
- b :b
- (third c) :c)
- (values a b c))
-
- ==> :A, :FOO, (1 2 :C 4)
-"
- (multiple-value-bind (gvars vals gstorevars setter getter)
- (get-setf-expansion place env)
- (when (second gstorevars)
- (error "ENSUREF does not support setting multiple values ~
- via the (VALUES ...) place."))
- (if (null more)
- (let ((gstorevar (first gstorevars))
- (gtmp (gensym "CURVAL+")))
- `(let ,(mapcar #'list gvars vals)
- (let ((,gtmp ,getter))
- (if ,gtmp
- ,gtmp
- (let ((,gstorevar ,thing))
- ,setter)))))
- `(progn (ensuref ,place ,thing)
- (ensuref , at more)))))
diff --git a/doc/Makefile b/doc/Makefile
index 22d1c5f..99d6afa 100644
--- a/doc/Makefile
+++ b/doc/Makefile
@@ -1,9 +1,4 @@
-.PHONY: usage all clean html pdf
-
-usage:
- @echo "Targets: all, clean, html, pdf"
-
-all: html pdf
+.PHONY: clean html pdf
clean:
rm -rf include *.aux *.cp *.fn *.fns *.ky *.log *.pg *.toc *.tp *.tps *.vr *.pdf *.html
@@ -12,7 +7,7 @@ clean:
# to bootrap documentation for now.
include:
sbcl --eval '(progn (require :asdf) (require :alexandria) (rename-package :alexandria :alexandria))' \
- --eval '(load (merge-pathnames "doc/manual/docstrings.lisp" (posix-getenv "SBCL_SOURCE_ROOT")))' \
+ --eval '(load (merge-pathnames "doc/manual/docstrings" (posix-getenv "SBCL_SOURCE_ROOT")))' \
--eval '(sb-texinfo:generate-includes "include/" :alexandria)' \
--eval '(quit)'
mv include/fun-alexandria-type=.texinfo include/fun-alexandria-type-equal.texinfo
diff --git a/package.lisp b/package.lisp
index 61ba06c..81c1e58 100644
--- a/package.lisp
+++ b/package.lisp
@@ -230,5 +230,4 @@
#:symbolicate
#:assoc-value
#:rassoc-value
- #:ensuref
))
diff --git a/tests.lisp b/tests.lisp
index e2904cc..f717402 100644
--- a/tests.lisp
+++ b/tests.lisp
@@ -7,7 +7,7 @@
(in-package :alexandria-tests)
-(defun run-tests (&key ((:compiled *compile-tests*)))
+(defun run-tests (&key ((:compiled *compile-tests)))
(do-tests))
;;;; Arrays
--
Alexandria hooks/post-receive
More information about the alexandria-cvs
mailing list