November 2004 - small-cl-src@common-lisp.net

[Small-cl-src] What would var+++ be in CL?
by Ingvar 06 Jul '05

06 Jul '05

;;; Possibly a tad naive, but... (defmacro post-incf (form &optional (increment 1)) (let ((value (gensym "POST-INCF"))) `(let ((,value ,form)) (prog1 ,value (setf ,form (+ ,value ,increment))))))

2 1

[Small-cl-src] quasi-standard method combination
by Marco Baringer 04 Nov '04

04 Nov '04

(define-method-combination quasi-standard (&key (around-order :most-specific-first) (before-order :most-specific-first) (primary-order :most-specific-first) (after-order :most-specific-last)) ((around (:around)) (before (:before)) (primary () :required-t) (after (:after))) "Same semantics as standard method combination but the order of method application is settable. This method combination takes four arguments which allow you to change the order in which around, before, primary and after methods are called. The values of the keyword parameters must all be either :most-specific-last or :most-specific-first." (labels ((effective-order (methods order) (ecase order (:most-specific-first methods) (:most-specific-last (reverse methods)))) (call-methods (methods) (mapcar (lambda (meth) `(call-method ,meth)) methods))) (let* (;; reorder the methods based on the -order arguments (around (effective-order around around-order)) (before (effective-order before before-order)) (primary (effective-order primary primary-order)) (after (effective-order after after-order)) ;; inital value of the effective call is a call its primary ;; method(s) (form (case (length primary) (1 `(call-method ,(first primary))) (t `(call-method ,(first primary) ,(rest primary)))))) (when before ;; wrap FORM in calls to its before methods (setf form `(progn ,@(call-methods before) ,form))) (when after ;; wrap FORM in calls to its after methods (setf form `(multiple-value-prog1 ,form ,@(call-methods after)))) (when around ;; wrap FORM in calls to its around methods (setf form `(call-method ,(first around) (,@(rest around) (make-method ,form))))) form))) -- -Marco Ring the bells that still can ring. Forget your perfect offering. There is a crack in everything. That's how the light gets in. -Leonard Cohen

1 0

[Small-cl-src] m-v-b* and d-b* (auto-ignoring arguments called _)
by Andreas Fuchs 02 Nov '04

02 Nov '04

;;; Hi, ;;; ;;; I hope this code makes a few functions (like decode-universal-time) ;;; more useful. Each of these functions replaces variables with a ;;; symbol-name of _ with a (declare (ignore))d gensym. ;;; ;;; I'm sure everybody has already written something similar. ;;; "Somebody should write a CLRFI for that" (-: (require :iterate) ;; Yeah, sorry.. the solution using LOOP was ugly as hell. (defun replace-binds (binds) (iterate (for bind in binds) (typecase bind (cons (multiple-value-bind (result* ignore*) (replace-binds bind) (collecting result* into result) (appending ignore* into ignore))) (t (if (string-equal bind '_) (let ((sym (gensym))) (collect sym into result) (collect sym into ignore)) (collect bind into result)))) (finally (return (values result ignore))))) (defmacro destructuring-bind* (bind-list obj &rest body) (multiple-value-bind (binds ignores) (replace-binds bind-list) `(destructuring-bind ,binds ,obj (declare (ignore ,@ignores)) ,@body))) (defmacro multiple-value-bind* (bind-list obj &rest body) (multiple-value-bind (binds ignores) (replace-binds bind-list) `(multiple-value-bind ,binds ,obj (declare (ignore ,@ignores)) ,@body))) ;;; Have fun, -- Andreas Fuchs, <asf(a)boinkor.net>, asf(a)jabber.at, antifuchs

1 0