From asf at boinkor.net  Tue Nov  2 21:28:50 2004
From: asf at boinkor.net (Andreas Fuchs)
Date: Tue, 02 Nov 2004 22:28:50 +0100
Subject: [Small-cl-src] m-v-b* and d-b* (auto-ignoring arguments called _)
Message-ID: <87654o2b59.wl%asf@boinkor.net>

;;; 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 , at ignores))
       , at 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 , at ignores))
       , at body)))

;;; Have fun,
-- 
Andreas Fuchs, <asf at boinkor.net>, asf at jabber.at, antifuchs



From mb at bese.it  Thu Nov  4 13:25:55 2004
From: mb at bese.it (Marco Baringer)
Date: Thu, 04 Nov 2004 14:25:55 +0100
Subject: [Small-cl-src] quasi-standard method combination
Message-ID: <m2y8hh4ufw.fsf@bese.it>


(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