[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