- alexandria-devel - mailman3.common-lisp.net

[alexandria-devel] minor spelling patch
by Michael Stevens 26 Jan '13

26 Jan '13

Minor spelling improvements in README.

2 1

[alexandria-devel] Question about FORMAT-SYMBOL
by Luís Oliveira 26 Jan '13

26 Jan '13

Hello, I often try to support Allegro's modern mode by doing things like (format-symbol t "~A-~A" :foo :bar). We just came across an issue on #quicklisp where a user had set his *PRINT-CASE* to :DOWNCASE and that caused FORMAT-SYMBOL to intern lower-case symbols, thus breaking the idiom I described. Should fix my code to use SYMBOLICATE instead or should FORMAT-SYMBOL use WITH-STANDARD-IO-SYNTAX? Any opinions? -- Luís Oliveira http://r42.eu/~luis

5 8

[alexandria-devel] Documentation fix and feature suggestion
by Jan Moringen 26 Jan '13

26 Jan '13

Dear alexandria developers, please the documentation fix and new functions in the two most recent commits in git://github.com/scymtym/alexandria.git for inclusion. Many thanks in advance. Kind regards, Jan

2 1

[alexandria-devel] Regarding %MULTIPLY-RANGE, BINOMIAL-COEFFICIENT
by Robert Smith 26 Jan '13

26 Jan '13

Hello all. I've been trying to speed up BINOMIAL-COEFFICIENT for combinatorial calculations and ended up writing my own functions which were originally based off of Alexandria's design. For computing the binomial coefficient of (10^11, 10^5), Alexandria's takes about 9.990 seconds on my 64-bit Windows machine with a relatively recent SBCL with (optimize speed (safety 0) (debug 0)). I've ended up writing my own version of %MULTIPLY-RANGE, which I ended up calling RANGE-PRODUCT, and it's definition is: (declaim (ftype (function (integer integer) integer) range-product)) (defun range-product (lower upper) "Compute LOWER * (LOWER+1) * ... * (UPPER-1) * UPPER." (assert (<= lower upper)) (case (- upper lower) ((0) lower) ((1) (* lower upper)) (otherwise (let ((mid (floor (+ lower upper) 2))) (* (range-product lower mid) (range-product (1+ mid) upper)))))) [ from QTILITY: https://bitbucket.org/tarballs_are_good/qtility/src/65eff10fdece/arithmetic… ] >From that, the definition of FACTORIAL follows: (declaim (ftype (function ((integer 0)) (integer 1)) factorial)) (defun factorial (n) "Compute the factorial of N, N! = 1 * 2 * ... * N." (if (zerop n) 1 (range-product 1 n))) [ from QTILITY: https://bitbucket.org/tarballs_are_good/qtility/src/65eff10fdece/arithmetic… ] Then, I wrote BINOMIAL-COEFFICIENT that uses a closure to direct the swapping of the K and N-K, instead of mutating them. This seemed to at least help with SBCL's flow analysis. I also chose not to use CHECK-TYPE in favor of declarations (which I understand are not the same, but I think they should attempt to act the same given a sufficient compiler policy). (declaim (ftype (function ((integer 0) (integer 0)) (integer 0)) binomial-coefficient)) (defun binomial-coefficient (n k) "Binomial coefficient of N and K." (assert (>= n k)) (labels ((core (k n-k) (if (= 1 n-k) n (nth-value 0 (floor (range-product (+ k 1) n) (factorial n-k)))))) (declare (inline core) (ftype (function ((integer 0) (integer 0)) (integer 0)) core)) (if (or (zerop k) (= n k)) 1 (let ((n-k (- n k))) (declare (type (integer 0) n-k)) (if (< k n-k) (core n-k k) (core k n-k)))))) [ from QTILITY: https://bitbucket.org/tarballs_are_good/qtility/src/65eff10fdece/arithmetic… ] With the code above, I can compute the same binomial coefficient in about 7.503 seconds, so about a 2.5 second speed up. I'd like to submit a patch using the code above, but I could see how these speed ups are both implementation-dependent and platform-dependent. A particular unfortunate consequence is that we don't have those tweakable limits which (in theory; as the comments say) could be computed at compile time. Any thoughts? -Robert

2 1

[alexandria-devel] Bug in gaussian-random
by Andy Peterson 02 Oct '12

02 Oct '12

function: gaussian-random (&optional min max) If gaussian-random is called with a value for min and nil for max (or vice versa), the function could enter an infinite loop. example (gaussian-random 100 nil) almost always causes an infinite loop. If the first call to the local function "gauss" creates a value that does not satisify min, then the local function "guard" enters an infinite loop because guard is called with a value for max that is less than min. Sincerely, Andy Peterson

2 1

[alexandria-devel] starts-with-subseq buggy
by Nikodemus Siivola 02 Jun '12

02 Jun '12

Note to self: [18:17] <yates> pjb: yes, i did read that [18:17] <adeht> alexandria:starts-with-subseq is terribly buggy :( [18:19] * KognizantKog (~user(a)72.168.55.98) has joined #lisp [18:20] <yates> pjb: have you read http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_s.htm#satisfy_… [18:20] <yates> ? [18:21] <yates> do you disagree with the definition? [18:23] * teggi (~teggi(a)113.172.40.96) has joined #lisp [18:24] <fe[nl]ix> adeht: how so ? [18:25] <adeht> fe[nl]ix, for example you'd expect (starts-with-subseq "foo" "oop" :start1 1) to return true... but (i) it passes args to mismatch in the reverse order so start1 becomes start2 and (ii) it compares the result of mismatch to the whole prefix's length, so returns false Cheers, -- Nikodemus

1 0

[alexandria-devel] Nesting
by Faré 26 May '12

26 May '12

I've found the following definitions incredibly useful in (nest) allowing indentation to not get out of hand (nest) getting the good feeling of that binding has other languages (tsen) focusing on the thing at hand, not the intermediate definitions needed (tsen) "piping" results into a series of functions or forms. I don't like the name "tsen", though. "wrap" comes to mind. Maybe you have better suggestions. ;;; Nesting binding forms (from a suggestion by marco baringer) (defmacro with-nesting ((&key (from-end t)) &rest things) (if from-end `(nest ,@things) `(tsen ,@things))) (defmacro nest (&rest things) (reduce #'(lambda (outer inner) (append outer (list inner))) things :from-end t)) (defmacro tsen (&rest things) (reduce #'(lambda (inner outer) (append outer (list inner))) things :from-end nil)) In any case, I'd like these to become a standard part of alexandria. —♯ƒ • François-René ÐVB Rideau •Reflection&Cybernethics• http://fare.tunes.org Gauss, when asked how soon he expected to reach certain mathematical conclusions, replied that he had reached them long ago, all he was worrying about was how to reach them! [Karl F. Gauss (1777-1855), German mathematician]

1 0

[alexandria-devel] Split up Alexandria into an additional experimental package?
by Tobias C Rittweiler 26 Apr '12

26 Apr '12

What is a good way to handle new additions to Alexandria that are not fully fledged out yet? As Hans noticed himself over this week, it usually takes an incredible amount of time and effort to come up with something with complete semantics. Time is a scarce resource, and even if it was not, only experience and actual usage will discover edges cases. Common Lisp itself has been tried out and implemented many times during the standardization process itself which is one of the reasons it's engineered as well as it is. What about providing an :ALEXANDRIA.EXPERIMENTAL package that uses :ALEXANDRIA? New additions go into the experimental package which is advertised not necessarily to be fully backwards compatible. People can explicitly :IMPORT-FROM that package (which will continue to work even when the symbol moves from there into :ALEXANDRIA, assuming no incompatible changes have been made.) T

1 0

[alexandria-devel] DESTRUCTURE-CLAUSES - alexandria_destruct#9CF676.diff (1/1)
by Tobias C Rittweiler 26 Apr '12

26 Apr '12

I was pleased to discover that DESTRUCTURING-CASE made it into Alexandria meanwhile. Very nice! This allows me to share the little gem that I'm attaching with this posting. It's a handy macro to make writing macros like DEFPACKAGE, DEFGENERIC of DEFREADTABLE easy like a breeze. Happy to be giving back again! :-) T diff --git a/macros.lisp b/macros.lisp index 4450435..0d4b9e9 100644 --- a/macros.lisp +++ b/macros.lisp @@ -303,4 +303,76 @@ Example: (setf (documentation name 'function) (documentation 'destructuring-case 'function))) +;;; DESTRUCTURE-CLAUSES +(defmacro destructure-clauses (clauses patterns &body body) + "Utility macro to conveniently destructure DEFPACKAGE like clauses. + + clauses ::= clause* + clause ::= (keyword . list) ; e.g. (:FOO 1 :K 2) + + patterns ::= pattern* + pattern ::= (keyword . ordinary-lambda-list) ; e.g. (:FOO N &KEY K) + +The CAR of each clause in CLAUSES will be tried to be matched against +the CAR of each pattern in PATTERNS. If a match is found, the CDR of +the matched pattern is interpreted as an ordinary lambda list and its +parameters are bound to the values provided by the CDR of the clause. + +When all CLAUSES are processed, BODY will be executed with all the +parameters of the matched patterns bound appropriately. Notice that +parameters must hence be named distinctively in each pattern. + +Example: + + (defmacro defpackage (name &body clauses) + (destructure-clauses clauses + ((:use &rest uses) + (:nicknames &rest nicknames) + (:export &rest exports) + ...) + (expand-defpackage name uses nicknames exports ...)) + +Implementation note: + + That a pattern consists of ordinary lambda list and not of + destructuring lambda lists is a /shortcoming/ of the current + implementation. Patches are welcome. +" + (multiple-value-bind (pattern-table vars n-vars) + (loop for pattern in patterns + for vars = (ordinary-lambda-list-parameters (cdr pattern)) + for n-vars = (mapcar #'make-gensym vars) + collect (cons pattern (list vars n-vars)) into pattern-mappings + append vars into all-vars + append n-vars into all-n-vars + finally + (return (values (alist-hash-table pattern-mappings) + all-vars + all-n-vars))) + (with-unique-names (clause) + `(let ,n-vars + (dolist (,clause ,clauses) + (destructuring-ecase ,clause + ,@(loop for p in patterns + for (pattern-vars pattern-n-vars) = (gethash p pattern-table) + collect `(,p ,@(loop for var in pattern-vars + for n-var in pattern-n-vars + collect `(setq ,n-var ,var)))))) + (let ,(mapcar #'list vars n-vars) + ,@body))))) + +(defun ordinary-lambda-list-parameters (ordinary-lambda-list) + "Return a list of all parameter names in ORDINARY-LAMBDA-LIST." + (flet ((optional-parameter-name (spec) + (car spec)) + (key-parameter-name (spec) + (second (first spec)))) + (multiple-value-bind (reqs opts rest keys aok auxs) + (parse-ordinary-lambda-list ordinary-lambda-list) + (assert (null aok) () "&ALLOW-OTHER-KEYS not supported.") + (assert (null auxs) () "&AUX not supported.") + (append reqs + (mapcar #'optional-parameter-name opts) + (ensure-list rest) + (mapcar #'key-parameter-name keys))))) \ No newline at end of file diff --git a/package.lisp b/package.lisp index babeb95..a025cc7 100644 --- a/package.lisp +++ b/package.lisp @@ -240,4 +240,5 @@ #:destructuring-case #:destructuring-ccase #:destructuring-ecase + #:destructure-clauses )) diff --git a/tests.lisp b/tests.lisp index e218113..51ea8ca 100644 --- a/tests.lisp +++ b/tests.lisp @@ -1856,3 +1856,47 @@ (when err (incf n)))))) 13) + +(deftest destructure-clauses.1 + (let ((+clauses+ '((:required-1 :R1) + (:required-n :R2 :R3 :R4) + (:optional-0) + (:optional-1 :O2) + (:key-0) + (:key-1 :KEY2 :K2) + (:key-n :KEY3 :K3 :KEY4 :K4) + (:required+optional-0 :R5) + (:required+optional-1 :R6 :O4) + (:required+key :R7 :R8 :KEY5 :K5)))) + (destructure-clauses +clauses+ + ((:required-1 req1) + (:required-n req2 req3 req4) + (:optional-0 &optional (opt1 :O1)) + (:optional-1 &optional opt2) + (:key-0 &key (key1 :K1)) + (:key-1 &key key2) + (:key-n &key key3 key4) + (:required+optional-0 req5 &optional (opt3 :O3)) + (:required+optional-1 req6 &optional opt4) + (:required+key req7 req8 &key key5)) + (values + (list req1) + (list req2 req3 req4) + (list opt1) + (list opt2) + (list key1) + (list key2) + (list key3 key4) + (list req5 opt3) + (list req6 opt4) + (list req7 req8 key5)))) + (:R1) + (:R2 :R3 :R4) + (:O1) + (:O2) + (:K1) + (:K2) + (:K3 :K4) + (:R5 :O3) + (:R6 :O4) + (:R7 :R8 :K5)) \ No newline at end of file

3 4

[alexandria-devel] Proposed addition of temporary file creation utilities
by Hans Hübner 26 Apr '12

26 Apr '12

Hi, following up on an IRC discussion yesterday, I am proposing the addition of the OPEN-TEMPORARY function and WITH-OPEN-TEMPORARY-FILE macro below (and on http://paste.lisp.org/display/129090#14) It implements functionality that is commonly required, but that is not available in any other library in a portable fashion. osicat has been suggested, but it does not implement temporary file handling on Windows. This posting is to determine whether there is opposition regarding inclusion in Alexandria. I'll re-post as a proper patch including symbol exports when there is agreement to include it. -Hans (in-package :alexandria) (defparameter *default-temporary-directory* #P"/tmp/") (eval-when (:load-toplevel :execute) (when (and (null (logical-pathname-translations "TEMPORARY-FILES")) (probe-file *default-temporary-directory*)) (setf (logical-pathname-translations "temporary-files") `(("*.*.*" ,*default-temporary-directory*))))) (defparameter *max-tries* 10000) (defun generate-random-name (prefix) (format nil "~A-~36R-~36R" prefix (random 100000000) (get-internal-real-time))) (define-condition cannot-create-temporary-file (error) ((directory :initarg :directory) (prefix :initarg :prefix) (type :initarg :type) (max-tries :initarg :max-tries)) (:report (lambda (condition stream) (with-slots (directory prefix type max-tries) condition (format stream "cannot create temporary file in directory ~A with template ~A.~A, giving up after ~D attempt~:P" (translate-logical-pathname directory) prefix type max-tries))))) (defun open-temporary (&rest open-arguments &key type (prefix "temp") (directory #P"TEMPORARY-FILES:") (generate-random-name 'generate-random-name) (max-tries *max-tries*) &allow-other-keys) "Create a file with a randomly generated name and return the opened stream. The generated pathname consists of the PREFIX with a pseudo-random suffix. Its type will be TYPE. Temporary files are generated in DIRECTORY which defaults to the logical pathname temporary TEMPORARY-FILES:, which must be properly set up. The name of the temporary file can be accessed calling the PATHNAME function on STREAM. For convenience, the temporary file is opened on the physical pathname, i.e. the pathname translation is performed before opening the stream. GENERATE-RANDOM-NAME can be passed to override the default function that transforms PREFIX into a pseudorandom file name. It needs to accept one argument, the PREFIX string passed, and return the generated file name. In order to create a unique file name, OPEN-TEMPORARY may loop internally up to MAX-TRIES times before giving up and signalling a CANNOT-CREATE-TEMPORARY-FILE condition." (loop thereis (apply #'open (translate-logical-pathname (make-pathname :name (funcall generate-random-name prefix) :type type :defaults directory)) :direction :output :if-exists nil (remove-from-plist open-arguments :type prefix directory generate-random-name max-tries)) repeat max-tries finally (error 'cannot-create-temporary-file :directory directory :prefix prefix :type type :max-tries max-tries))) (defmacro with-open-temporary-file ((stream &rest args) &body body) "Create a temporary file using OPEN-TEMPORARY with ARGS and run BODY with STREAM bound to the temporary file stream. See OPEN-TEMPORARY for permitted options." `(with-open-stream (,stream (open-temporary ,@args)) ,@body))

8 18