small-cl-src November 2004

small-cl-src@common-lisp.net

2 participants
3 discussions

[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

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

small-cl-src November 2004